SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/regular_grid

Go to the documentation of this file.
00001 !     ################################################################
00002       SUBROUTINE REGULAR_GRID_SPAWN(KLUOUT,                               &
00003                                       KL1, KIMAX1,KJMAX1,PX1,PY1,PDX1,PDY1, &
00004                                       KXOR, KYOR, KDXRATIO, KDYRATIO,       &
00005                                       KXSIZE, KYSIZE,                       &
00006                                       KL2, KIMAX2,KJMAX2,PX2,PY2,PDX2,PDY2  )  
00007 !     ################################################################
00008 !
00009 !!****  *REGULAR_GRID_SPAWN* - routine to read in namelist the horizontal grid
00010 !!
00011 !!    PURPOSE
00012 !!    -------
00013 !!
00014 !!**  METHOD
00015 !!    ------
00016 !!
00017 !!    EXTERNAL
00018 !!    --------
00019 !!
00020 !!
00021 !!    IMPLICIT ARGUMENTS
00022 !!    ------------------
00023 !!
00024 !!    REFERENCE
00025 !!    ---------
00026 !!
00027 !!
00028 !!    AUTHOR
00029 !!    ------
00030 !!      V. Masson   *Meteo France*      
00031 !!
00032 !!    MODIFICATIONS
00033 !!    -------------
00034 !!      Original    01/2004 
00035 !-------------------------------------------------------------------------------
00036 !
00037 !*       0.    DECLARATIONS
00038 !              ------------
00039 !
00040 USE MODD_SURF_PAR, ONLY : NUNDEF
00041 !
00042 !
00043 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00044 USE PARKIND1  ,ONLY : JPRB
00045 !
00046 USE MODI_ABOR1_SFX
00047 !
00048 IMPLICIT NONE
00049 !
00050 !*       0.1   Declarations of arguments
00051 !              -------------------------
00052 !
00053 INTEGER,                      INTENT(IN)    :: KLUOUT     ! output listing logical unit
00054 INTEGER,                      INTENT(IN)    :: KL1        ! total number of points KIMAX1 * KJMAX1
00055 INTEGER,                      INTENT(IN)    :: KIMAX1     ! number of points in x direction
00056 INTEGER,                      INTENT(IN)    :: KJMAX1     ! number of points in y direction
00057 REAL, DIMENSION(KL1),         INTENT(IN)    :: PX1        ! X coordinate of all points
00058 REAL, DIMENSION(KL1),         INTENT(IN)    :: PY1        ! Y coordinate of all points
00059 REAL, DIMENSION(KL1),         INTENT(IN)    :: PDX1       ! X mesh size of all points
00060 REAL, DIMENSION(KL1),         INTENT(IN)    :: PDY1       ! Y mesh size of all points
00061 INTEGER,                      INTENT(IN)    :: KXOR       ! position of modified bottom left point
00062 INTEGER,                      INTENT(IN)    :: KYOR       ! according to initial grid
00063 INTEGER,                      INTENT(IN)    :: KXSIZE     ! number of grid meshes in initial grid to be
00064 INTEGER,                      INTENT(IN)    :: KYSIZE     ! covered by the modified grid
00065 INTEGER,                      INTENT(IN)    :: KDXRATIO   ! resolution ratio between modified grid
00066 INTEGER,                      INTENT(IN)    :: KDYRATIO   ! and initial grid
00067 INTEGER,                      INTENT(IN)    :: KL2        ! total number of points KIMAX2 * KJMAX2
00068 INTEGER,                      INTENT(IN)    :: KIMAX2     ! number of points in x direction
00069 INTEGER,                      INTENT(IN)    :: KJMAX2     ! number of points in y direction
00070 REAL, DIMENSION(KL2),         INTENT(OUT)   :: PX2        ! X coordinate of all points
00071 REAL, DIMENSION(KL2),         INTENT(OUT)   :: PY2        ! Y coordinate of all points
00072 REAL, DIMENSION(KL2),         INTENT(OUT)   :: PDX2       ! X mesh size of all points
00073 REAL, DIMENSION(KL2),         INTENT(OUT)   :: PDY2       ! Y mesh size of all points
00074 !
00075 !*       0.2   Declarations of local variables
00076 !              -------------------------------
00077 !
00078 !* initial grid
00079 !
00080 REAL, DIMENSION(:),   ALLOCATABLE :: ZXM1     ! X coordinate of center of mesh (IIMAX1   points)
00081 REAL, DIMENSION(:),   ALLOCATABLE :: ZYM1     ! Y coordinate of center of mesh (IJMAX1   points)
00082 REAL, DIMENSION(:),   ALLOCATABLE :: ZXHAT1   ! X coordinate of left side      (IIMAX1+1 points)
00083 REAL, DIMENSION(:),   ALLOCATABLE :: ZYHAT1   ! Y coordinate of bottom side    (IJMAX1+1 points)
00084 !
00085 !* new grid
00086 !
00087 REAL, DIMENSION(:),   ALLOCATABLE :: ZXHAT2   ! X coordinate of left side      (IIMAX2 points)
00088 REAL, DIMENSION(:),   ALLOCATABLE :: ZYHAT2   ! Y coordinate of bottom side    (IJMAX2 points)
00089 !
00090 !* other variables
00091 !
00092 INTEGER     :: JL            ! loop counter
00093 INTEGER     :: JI,JJ         ! loop controls relatively to modified grid
00094 INTEGER     :: JIBOX,JJBOX   ! grid mesh relatively to initial grid
00095 REAL        :: ZCOEF         ! ponderation coefficient for linear interpolation
00096 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00097 !
00098 !------------------------------------------------------------------------------
00099 !
00100 !*       1.    Coherence tests
00101 !              ---------------
00102 !
00103 !* tests
00104 !
00105 IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',0,ZHOOK_HANDLE)
00106 IF ( KXOR+KXSIZE-1 > KIMAX1 ) THEN
00107   WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
00108   WRITE(KLUOUT,*) 'IXOR = ', KXOR, ' IXSIZE = ', KXSIZE,&
00109                     ' with NIMAX(file) = ', KIMAX1  
00110   CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (1) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
00111 END IF
00112 IF ( KYOR+KYSIZE-1 > KJMAX1 ) THEN
00113   WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
00114   WRITE(KLUOUT,*) 'IYOR = ', KYOR, ' IYSIZE = ', KYSIZE,&
00115                     ' with NJMAX(file) = ', KJMAX1  
00116   CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (2) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
00117 END IF
00118 !
00119 !------------------------------------------------------------------------------
00120 !
00121 !*       2.    Center of mesh coordinate arrays for each direction separately
00122 !              --------------------------------------------------------------
00123 !
00124 ALLOCATE(ZXM1  (KIMAX1))
00125 ALLOCATE(ZYM1  (KJMAX1))
00126 ALLOCATE(ZXHAT1(KIMAX1+1))
00127 ALLOCATE(ZYHAT1(KJMAX1+1))
00128 ALLOCATE(ZXHAT2(KIMAX2+1))
00129 ALLOCATE(ZYHAT2(KJMAX2+1))
00130 !
00131 ZXM1(:) = PX1(1:KIMAX1)
00132 DO JL=1,KL1
00133   IF (MOD(JL,KIMAX1)==0) ZYM1(JL/KIMAX1) = PY1(JL)
00134 END DO
00135 !
00136 !------------------------------------------------------------------------------
00137 !
00138 !*       3.    side of mesh coordinate arrays for each direction separately
00139 !              ------------------------------------------------------------
00140 !
00141 !
00142 IF (KIMAX1==1) THEN
00143   ZXHAT1(1) = ZXM1(1) - 0.5 * PDX1(1)
00144   ZXHAT1(2) = ZXM1(1) + 0.5 * PDX1(1)
00145 ELSE
00146   ZXHAT1(1) = 1.5 * ZXM1(1) - 0.5 * ZXM1(2)
00147   DO JI=2,KIMAX1
00148     ZXHAT1(JI) = 0.5 * ZXM1(JI-1) + 0.5 * ZXM1(JI)
00149   END DO
00150   ZXHAT1(KIMAX1+1) = 1.5 * ZXM1(KIMAX1) - 0.5 * ZXM1(KIMAX1-1)
00151 END IF
00152 !
00153 IF (KJMAX1==1) THEN
00154   ZYHAT1(1) = ZYM1(1) - 0.5 * PDY1(1)
00155   ZYHAT1(2) = ZYM1(1) + 0.5 * PDY1(1)
00156 ELSE
00157   ZYHAT1(1) = 1.5 * ZYM1(1) - 0.5 * ZYM1(2)
00158   DO JJ=2,KJMAX1
00159     ZYHAT1(JJ) = 0.5 * ZYM1(JJ-1) + 0.5 * ZYM1(JJ)
00160   END DO
00161   ZYHAT1(KJMAX1+1) = 1.5 * ZYM1(KJMAX1) - 0.5 * ZYM1(KJMAX1-1)
00162 END IF
00163 !
00164 !------------------------------------------------------------------------------
00165 !
00166 !*       5.    Interpolation of coordinate arrays for each direction separately
00167 !              ----------------------------------------------------------------
00168 !
00169 !* X coordinate array
00170 !
00171 DO JI=1,KIMAX2
00172   JIBOX=(JI-1)/KDXRATIO + KXOR
00173   ZCOEF= FLOAT(MOD(JI-1,KDXRATIO))/FLOAT(KDXRATIO)
00174   ZXHAT2(JI)=(1.-ZCOEF)*ZXHAT1(JIBOX)+ZCOEF*ZXHAT1(JIBOX+1)
00175 END DO
00176 IF (KIMAX2==1) THEN
00177   ZXHAT2(KIMAX2+1) = ZXHAT2(KIMAX2) + ZXHAT1(JIBOX+1) - ZXHAT1(JIBOX)
00178 ELSE
00179   ZXHAT2(KIMAX2+1) = 2. * ZXHAT2(KIMAX2) - ZXHAT2(KIMAX2-1)
00180 END IF
00181 !
00182 !
00183 !* Y coordinate array
00184 !
00185 DO JJ=1,KJMAX2
00186   JJBOX=(JJ-1)/KDYRATIO + KYOR
00187   ZCOEF= FLOAT(MOD(JJ-1,KDYRATIO))/FLOAT(KDYRATIO)
00188   ZYHAT2(JJ)=(1.-ZCOEF)*ZYHAT1(JJBOX)+ZCOEF*ZYHAT1(JJBOX+1)
00189 END DO
00190 IF (KJMAX2==1) THEN
00191   ZYHAT2(KJMAX2+1) = ZYHAT2(KJMAX2) + ZYHAT1(JJBOX+1) - ZYHAT1(JJBOX)
00192 ELSE
00193   ZYHAT2(KJMAX2+1) = 2. * ZYHAT2(KJMAX2) - ZYHAT2(KJMAX2-1)
00194 END IF
00195 !---------------------------------------------------------------------------
00196 DEALLOCATE(ZXM1)
00197 DEALLOCATE(ZYM1)
00198 DEALLOCATE(ZXHAT1)
00199 DEALLOCATE(ZYHAT1)
00200 !------------------------------------------------------------------------------
00201 !
00202 !*       5.    Coordinate arrays of all points
00203 !              -------------------------------
00204 !
00205 DO JJ=1,KJMAX2
00206   DO JI=1,KIMAX2
00207     JL = (JJ-1) * KIMAX2 + JI
00208       PX2 (JL) = 0.5 * ZXHAT2(JI) + 0.5 * ZXHAT2(JI+1)
00209       PDX2(JL) = ZXHAT2(JI+1) - ZXHAT2(JI)
00210       PY2 (JL) = 0.5 * ZYHAT2(JJ) + 0.5 * ZYHAT2(JJ+1)
00211       PDY2(JL) = ZYHAT2(JJ+1) - ZYHAT2(JJ)
00212   END DO
00213 END DO
00214 !
00215 !---------------------------------------------------------------------------
00216 DEALLOCATE(ZXHAT2)
00217 DEALLOCATE(ZYHAT2)
00218 IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',1,ZHOOK_HANDLE)
00219 !---------------------------------------------------------------------------
00220 !
00221 END SUBROUTINE REGULAR_GRID_SPAWN