SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/ol_define

Go to the documentation of this file.
00001 SUBROUTINE OL_DEFINE_DIM(HPROGRAM, KLUOUT, KNI, KDIM1, HUNIT1, HUNIT2, &
00002                          PX, PY, KDIMS, KDDIM, HNAME_DIM, KNPATCH)
00003 !     #######################################################
00004 !!****  *OL_DEFINE_DIM* - 
00005 !!
00006 !!    PURPOSE
00007 !!    -------
00008 !!
00009       !!
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      S. Faroux   *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    06/2010 
00031 !!      07/2011     add specific computation for IGN grid (B. Decharme)
00032 !-------------------------------------------------------------------------------                         
00033 !
00034 USE MODD_SURF_ATM_GRID_n, ONLY : CGRID, NGRID_PAR, XGRID_FULL_PAR
00035 USE MODD_IO_SURF_OL, ONLY: NMASK_IGN
00036 !
00037 USE MODN_IO_OFFLINE, ONLY : LWRITE_COORD
00038 !
00039 USE MODI_GET_GRID_DIM
00040 USE MODI_GET_GRID_COORD
00041 !
00042 USE MODE_GRIDTYPE_IGN
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 include 'netcdf.inc'
00049 !
00050  CHARACTER(LEN=6),  INTENT(IN)    :: HPROGRAM
00051 INTEGER, INTENT(IN)              :: KLUOUT
00052 INTEGER, INTENT(IN)              :: KNI
00053 INTEGER, INTENT(OUT)             :: KDIM1
00054  CHARACTER(LEN=13) , DIMENSION(:), INTENT(OUT) :: HUNIT1, HUNIT2
00055 REAL,DIMENSION(:), POINTER                :: PX, PY
00056 INTEGER, DIMENSION(:), POINTER            :: KDIMS, KDDIM
00057  CHARACTER(LEN=100), DIMENSION(:), POINTER :: HNAME_DIM
00058 INTEGER, OPTIONAL, INTENT(IN)    :: KNPATCH
00059 !
00060 REAL, DIMENSION(KNI)             :: ZXX, ZYY
00061  CHARACTER(LEN=3)                 :: YTYPE
00062 INTEGER                          :: INDIMS, IDIM2
00063 INTEGER                          :: I, J, K, L
00064 LOGICAL                          :: GRECT     ! T if rectangular grid
00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00066 !
00067 IF (LHOOK) CALL DR_HOOK('OL_DEFINE_DIM',0,ZHOOK_HANDLE)
00068 !
00069 KDIM1=0
00070 IDIM2=0
00071 !
00072 IF (.NOT.LWRITE_COORD) THEN
00073   !
00074   IF ( CGRID.EQ.'CONF PROJ ' .OR. CGRID.EQ.'CARTESIAN '&
00075   .OR. CGRID.EQ.'LONLAT REG' .OR. CGRID.EQ.'IGN' ) THEN
00076     YTYPE='XY '
00077     IF (CGRID.EQ.'LONLAT REG') YTYPE='LON'
00078     CALL GET_GRID_DIM(CGRID,NGRID_PAR,XGRID_FULL_PAR,GRECT,KDIM1,IDIM2)
00079   ENDIF
00080   !
00081 ENDIF
00082 !
00083 INDIMS = 2
00084 IF ( KDIM1.NE.0       ) INDIMS = 3
00085 IF ( PRESENT(KNPATCH) ) INDIMS = INDIMS + 1
00086 !
00087 ALLOCATE(KDIMS(INDIMS))
00088 ALLOCATE(KDDIM(INDIMS))
00089 ALLOCATE(HNAME_DIM(INDIMS))
00090 !
00091 IF ( KDIM1.NE.0 ) THEN
00092   KDIMS(1) = KDIM1
00093   KDIMS(2) = IDIM2
00094   IF (YTYPE.EQ.'LON') THEN
00095     HNAME_DIM(1) = 'lon'
00096     HNAME_DIM(2) = 'lat'
00097     HUNIT1(1)    = 'degrees_east'
00098     HUNIT2(1)    = 'degrees_north'
00099   ELSE
00100     HNAME_DIM(1) = 'xx'
00101     HNAME_DIM(2) = 'yy'
00102     HUNIT1(1)    = 'meters'
00103     HUNIT2(1)    = 'meters'
00104   ENDIF
00105   ALLOCATE(PX(KDIM1))
00106   ALLOCATE(PY(IDIM2))
00107 ELSE
00108   KDIMS(1) = KNI
00109   HNAME_DIM(1) = 'Number_of_points' 
00110   IF (LWRITE_COORD) THEN
00111     ALLOCATE(PX(KNI))
00112     ALLOCATE(PY(KNI))
00113   ENDIF
00114 ENDIF
00115 !
00116 IF (LWRITE_COORD) THEN
00117   !
00118   CALL GET_GRID_COORD(KLUOUT,PX=PX,PY=PY,KL=KNI,HGRID=CGRID,PGRID_PAR=XGRID_FULL_PAR)
00119   !
00120 ELSEIF ( CGRID.EQ.'CONF PROJ '.OR. CGRID.EQ.'CARTESIAN '.OR. &
00121          CGRID.EQ.'LONLAT REG' ) THEN
00122   !
00123   CALL GET_GRID_COORD(KLUOUT,PX=ZXX,PY=ZYY,KL=KNI,HGRID=CGRID,PGRID_PAR=XGRID_FULL_PAR)
00124   !
00125   IF (ASSOCIATED(PX)) THEN
00126     DO J=1,SIZE(PX)
00127       PX(J)=ZXX(J)
00128     ENDDO
00129   ENDIF
00130   IF (ASSOCIATED(PY)) THEN
00131     DO J=1,SIZE(PY)
00132       PY(J)=ZYY((J-1)*(KNI/SIZE(PY))+1)
00133     ENDDO
00134   ENDIF
00135 !
00136 ELSEIF(CGRID.EQ.'IGN       ')THEN
00137   !
00138   CALL GET_GRIDTYPE_IGN(XGRID_FULL_PAR,PX=ZXX,PY=ZYY,PXALL=PX,PYALL=PY)
00139   !
00140   IF (.NOT.ALLOCATED(NMASK_IGN))THEN
00141     ALLOCATE(NMASK_IGN(KNI))
00142     L=0
00143     DO J=1,SIZE(PY)    
00144       DO I=1,SIZE(PX)
00145         L=L+1
00146         DO K=1,KNI
00147           IF((ZXX(K)==PX(I)).AND.(ZYY(K)==PY(J)))THEN
00148             NMASK_IGN(K)=L
00149           ENDIF
00150         ENDDO
00151       ENDDO
00152     ENDDO
00153   ENDIF
00154   !
00155 ENDIF
00156 !
00157 !
00158 IF (PRESENT(KNPATCH)) THEN
00159   KDIMS     (INDIMS-1) = KNPATCH
00160   HNAME_DIM (INDIMS-1) = 'Number_of_Tile'
00161 ENDIF
00162 !
00163 KDIMS     (INDIMS) = NF_UNLIMITED
00164 HNAME_DIM (INDIMS) = 'time'
00165 !
00166 IF (LHOOK) CALL DR_HOOK('OL_DEFINE_DIM',1,ZHOOK_HANDLE)
00167 !
00168 END SUBROUTINE OL_DEFINE_DIM