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

Go to the documentation of this file.
00001 !     ##########################
00002       MODULE MODI_PACK_SAME_RANK
00003 !     ##########################
00004 INTERFACE PACK_SAME_RANK
00005       SUBROUTINE PACK_SAME_RANK_FROM1DI(KM,K1D_IN,K1D_OUT)
00006 
00007 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00008 INTEGER, DIMENSION(:),   INTENT(IN) :: K1D_IN
00009 INTEGER, DIMENSION(:),   INTENT(OUT):: K1D_OUT
00010 END SUBROUTINE PACK_SAME_RANK_FROM1DI
00011 !
00012       SUBROUTINE PACK_SAME_RANK_FROM1DL(KM,O1D_IN,O1D_OUT)
00013 
00014 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00015 LOGICAL, DIMENSION(:),   INTENT(IN) :: O1D_IN
00016 LOGICAL, DIMENSION(:),   INTENT(OUT):: O1D_OUT
00017 END SUBROUTINE PACK_SAME_RANK_FROM1DL
00018 !
00019       SUBROUTINE PACK_SAME_RANK_FROM1D(KM,P1D_IN,P1D_OUT)
00020 
00021 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00022 REAL, DIMENSION(:),   INTENT(IN) :: P1D_IN
00023 REAL, DIMENSION(:),   INTENT(OUT):: P1D_OUT
00024 END SUBROUTINE PACK_SAME_RANK_FROM1D
00025 !
00026       SUBROUTINE PACK_SAME_RANK_FROM2D(KM,P2D_IN,P2D_OUT)
00027 
00028 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00029 REAL, DIMENSION(:,:), INTENT(IN) :: P2D_IN
00030 REAL, DIMENSION(:,:), INTENT(OUT):: P2D_OUT
00031 !
00032 END SUBROUTINE PACK_SAME_RANK_FROM2D
00033 !
00034       SUBROUTINE PACK_SAME_RANK_FROM3D(KM,P3D_IN,P3D_OUT)
00035 
00036 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00037 REAL, DIMENSION(:,:,:), INTENT(IN) :: P3D_IN
00038 REAL, DIMENSION(:,:,:), INTENT(OUT):: P3D_OUT
00039 !
00040 END SUBROUTINE PACK_SAME_RANK_FROM3D
00041 !
00042       SUBROUTINE PACK_SAME_RANK_FROM4D(KM,P4D_IN,P4D_OUT)
00043 
00044 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00045 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: P4D_IN
00046 REAL, DIMENSION(:,:,:,:),   INTENT(OUT):: P4D_OUT
00047 !
00048 END SUBROUTINE PACK_SAME_RANK_FROM4D
00049 !
00050 END INTERFACE PACK_SAME_RANK
00051 !
00052 END MODULE MODI_PACK_SAME_RANK
00053 !
00054 !     ##############################################
00055       SUBROUTINE PACK_SAME_RANK_FROM1D(KM,P1D_IN,P1D_OUT)
00056 !     ##############################################
00057 !
00058 !!****  *PACK_SAME_RANK* - extract the defined data from a 1D field into a 1D field of lower rank
00059 !!
00060 !!    PURPOSE
00061 !!    -------
00062 !!
00063 !!**  METHOD
00064 !!    ------
00065 !!
00066 !!    EXTERNAL
00067 !!    --------
00068 !!
00069 !!
00070 !!    IMPLICIT ARGUMENTS
00071 !!    ------------------
00072 !!
00073 !!    REFERENCE
00074 !!    ---------
00075 !!
00076 !!
00077 !!    AUTHOR
00078 !!    ------
00079 !!      F. Habets   *Meteo France*      
00080 !!
00081 !!    MODIFICATIONS
00082 !!    -------------
00083 !!      Original    08/03
00084 !-------------------------------------------------------------------------------
00085 !
00086 !*       0.    DECLARATIONS
00087 !              ------------
00088 !
00089 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00090 USE PARKIND1  ,ONLY : JPRB
00091 !
00092 IMPLICIT NONE
00093 !
00094 !*       0.1   Declarations of arguments
00095 !              -------------------------
00096 !
00097 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00098 REAL, DIMENSION(:),   INTENT(IN) :: P1D_IN
00099 REAL, DIMENSION(:),   INTENT(OUT):: P1D_OUT
00100 !
00101 !*       0.2   Declarations of local variables
00102 !              -------------------------------
00103 !
00104 INTEGER :: JI ! loop counter
00105 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00106 !
00107 !-------------------------------------------------------------------------------
00108 !
00109 !
00110 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM1D',0,ZHOOK_HANDLE)
00111 !cdir nodep
00112 DO JI=1,SIZE(P1D_OUT,1)
00113   P1D_OUT(JI) = P1D_IN(KM(JI)) 
00114 ENDDO
00115 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM1D',1,ZHOOK_HANDLE)
00116 !
00117 !-------------------------------------------------------------------------------
00118 !
00119 END SUBROUTINE PACK_SAME_RANK_FROM1D
00120 !
00121 !
00122 !     ##############################################
00123       SUBROUTINE PACK_SAME_RANK_FROM1DI(KM,K1D_IN,K1D_OUT)
00124 !     ##############################################
00125 !
00126 !!****  *PACK_SAME_RANK* - extract the defined data from a 1D field into a 1D field of lower rank
00127 !!
00128 !!    PURPOSE
00129 !!    -------
00130 !!
00131 !!**  METHOD
00132 !!    ------
00133 !!
00134 !!    EXTERNAL
00135 !!    --------
00136 !!
00137 !!
00138 !!    IMPLICIT ARGUMENTS
00139 !!    ------------------
00140 !!
00141 !!    REFERENCE
00142 !!    ---------
00143 !!
00144 !!
00145 !!    AUTHOR
00146 !!    ------
00147 !!      F. Habets   *Meteo France*      
00148 !!
00149 !!    MODIFICATIONS
00150 !!    -------------
00151 !!      Original    08/03
00152 !-------------------------------------------------------------------------------
00153 !
00154 !*       0.    DECLARATIONS
00155 !              ------------
00156 !
00157 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00158 USE PARKIND1  ,ONLY : JPRB
00159 !
00160 IMPLICIT NONE
00161 !
00162 !*       0.1   Declarations of arguments
00163 !              -------------------------
00164 !
00165 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00166 INTEGER, DIMENSION(:),   INTENT(IN) :: K1D_IN
00167 INTEGER, DIMENSION(:),   INTENT(OUT):: K1D_OUT
00168 !
00169 !*       0.2   Declarations of local variables
00170 !              -------------------------------
00171 !
00172 INTEGER :: JI ! loop counter
00173 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00174 !
00175 !-------------------------------------------------------------------------------
00176 !
00177 !
00178 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM1DI',0,ZHOOK_HANDLE)
00179 !cdir nodep
00180 DO JI=1,SIZE(K1D_OUT,1)
00181   K1D_OUT(JI) = K1D_IN(KM(JI)) 
00182 ENDDO
00183 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM1DI',1,ZHOOK_HANDLE)
00184 !
00185 !-------------------------------------------------------------------------------
00186 !
00187 END SUBROUTINE PACK_SAME_RANK_FROM1DI
00188 !
00189 !
00190 !     ##############################################
00191       SUBROUTINE PACK_SAME_RANK_FROM1DL(KM,O1D_IN,O1D_OUT)
00192 !     ##############################################
00193 !
00194 !!****  *PACK_SAME_RANK* - extract the defined data from a 1D field into a 1D field of lower rank
00195 !!
00196 !!    PURPOSE
00197 !!    -------
00198 !!
00199 !!**  METHOD
00200 !!    ------
00201 !!
00202 !!    EXTERNAL
00203 !!    --------
00204 !!
00205 !!
00206 !!    IMPLICIT ARGUMENTS
00207 !!    ------------------
00208 !!
00209 !!    REFERENCE
00210 !!    ---------
00211 !!
00212 !!
00213 !!    AUTHOR
00214 !!    ------
00215 !!      F. Habets   *Meteo France*      
00216 !!
00217 !!    MODIFICATIONS
00218 !!    -------------
00219 !!      Original    08/03
00220 !-------------------------------------------------------------------------------
00221 !
00222 !*       0.    DECLARATIONS
00223 !              ------------
00224 !
00225 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00226 USE PARKIND1  ,ONLY : JPRB
00227 !
00228 IMPLICIT NONE
00229 !
00230 !*       0.1   Declarations of arguments
00231 !              -------------------------
00232 !
00233 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00234 LOGICAL, DIMENSION(:),   INTENT(IN) :: O1D_IN
00235 LOGICAL, DIMENSION(:),   INTENT(OUT):: O1D_OUT
00236 !
00237 !*       0.2   Declarations of local variables
00238 !              -------------------------------
00239 !
00240 INTEGER :: JI ! loop counter
00241 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00242 !
00243 !-------------------------------------------------------------------------------
00244 !
00245 !
00246 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM1DL',0,ZHOOK_HANDLE)
00247 !cdir nodep
00248 DO JI=1,SIZE(O1D_OUT,1)
00249   O1D_OUT(JI) = O1D_IN(KM(JI)) 
00250 ENDDO
00251 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM1DL',1,ZHOOK_HANDLE)
00252 !
00253 !-------------------------------------------------------------------------------
00254 !
00255 END SUBROUTINE PACK_SAME_RANK_FROM1DL
00256 !
00257 !
00258 !     ##############################################
00259       SUBROUTINE PACK_SAME_RANK_FROM2D(KM,P2D_IN,P2D_OUT)
00260 !     ##############################################
00261 !
00262 !!****  *PACK_SAME_RANK* - extract the defined data from a 2D field into a 2D field
00263 !!
00264 !!    PURPOSE
00265 !!    -------
00266 !!
00267 !!**  METHOD
00268 !!    ------
00269 !!
00270 !!    EXTERNAL
00271 !!    --------
00272 !!
00273 !!
00274 !!    IMPLICIT ARGUMENTS
00275 !!    ------------------
00276 !!
00277 !!    REFERENCE
00278 !!    ---------
00279 !!
00280 !!
00281 !!    AUTHOR
00282 !!    ------
00283 !!      F. Habets   *Meteo France*      
00284 !!
00285 !!    MODIFICATIONS
00286 !!    -------------
00287 !!      Original    08/03
00288 !-------------------------------------------------------------------------------
00289 !
00290 !*       0.    DECLARATIONS
00291 !              ------------
00292 !
00293 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00294 USE PARKIND1  ,ONLY : JPRB
00295 !
00296 IMPLICIT NONE
00297 !
00298 !*       0.1   Declarations of arguments
00299 !              -------------------------
00300 !
00301 INTEGER, DIMENSION(:),  INTENT(IN) :: KM
00302 REAL, DIMENSION(:,:),   INTENT(IN) :: P2D_IN
00303 REAL, DIMENSION(:,:),   INTENT(OUT):: P2D_OUT
00304 !
00305 !*       0.2   Declarations of local variables
00306 !              -------------------------------
00307 !
00308 INTEGER :: JI, JJ ! loop counter
00309 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00310 !
00311 !-------------------------------------------------------------------------------
00312 !
00313 !
00314 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM2D',0,ZHOOK_HANDLE)
00315 DO JJ=1,SIZE(P2D_OUT,2)
00316 !cdir nodep
00317   DO JI=1,SIZE(P2D_OUT,1)
00318     P2D_OUT(JI,JJ) = P2D_IN(KM(JI),JJ)
00319   ENDDO 
00320 ENDDO
00321 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM2D',1,ZHOOK_HANDLE)
00322 !
00323 !-------------------------------------------------------------------------------
00324 !
00325 END SUBROUTINE PACK_SAME_RANK_FROM2D
00326 !
00327 !-------------------------------------------------------------------------------
00328 !-------------------------------------------------------------------------------
00329 !     ##############################################
00330       SUBROUTINE PACK_SAME_RANK_FROM3D(KM,P3D_IN,P3D_OUT)
00331 !     ##############################################
00332 !
00333 !!****  *PACK_SAME_RANK* - extract the defined data from a 3D field into a 3D field
00334 !!
00335 !!    PURPOSE
00336 !!    -------
00337 !!
00338 !!**  METHOD
00339 !!    ------
00340 !!
00341 !!    EXTERNAL
00342 !!    --------
00343 !!
00344 !!
00345 !!    IMPLICIT ARGUMENTS
00346 !!    ------------------
00347 !!
00348 !!    REFERENCE
00349 !!    ---------
00350 !!
00351 !!
00352 !!    AUTHOR
00353 !!    ------
00354 !!      F. Habets   *Meteo France*      
00355 !!
00356 !!    MODIFICATIONS
00357 !!    -------------
00358 !!      Original    08/03
00359 !-------------------------------------------------------------------------------
00360 !
00361 !*       0.    DECLARATIONS
00362 !              ------------
00363 !
00364 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00365 USE PARKIND1  ,ONLY : JPRB
00366 !
00367 IMPLICIT NONE
00368 !
00369 !*       0.1   Declarations of arguments
00370 !              -------------------------
00371 !
00372 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00373 REAL, DIMENSION(:,:,:),  INTENT(IN) :: P3D_IN
00374 REAL, DIMENSION(:,:,:),  INTENT(OUT):: P3D_OUT
00375 !
00376 !*       0.2   Declarations of local variables
00377 !              -------------------------------
00378 !
00379 INTEGER :: JI, JJ, JK ! loop counter
00380 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00381 !
00382 !-------------------------------------------------------------------------------
00383 !
00384 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM3D',0,ZHOOK_HANDLE)
00385 DO JK=1,SIZE(P3D_OUT,3)
00386   DO JJ=1,SIZE(P3D_OUT,2)
00387 !cdir nodep
00388     DO JI=1,SIZE(P3D_OUT,1)
00389       P3D_OUT(JI,JJ,JK) = P3D_IN(KM(JI),JJ,JK)
00390     ENDDO
00391   ENDDO 
00392 ENDDO
00393 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM3D',1,ZHOOK_HANDLE)
00394 !
00395 !-------------------------------------------------------------------------------
00396 !
00397 END SUBROUTINE PACK_SAME_RANK_FROM3D
00398 !
00399 !-------------------------------------------------------------------------------
00400 !-------------------------------------------------------------------------------
00401 !     ##############################################
00402       SUBROUTINE PACK_SAME_RANK_FROM4D(KM,P4D_IN,P4D_OUT)
00403 !     ##############################################
00404 !
00405 !!****  *PACK_SAME_RANK* - extract the defined data from a 4D field into a 4D field
00406 !!
00407 !!    PURPOSE
00408 !!    -------
00409 !!
00410 !!**  METHOD
00411 !!    ------
00412 !!
00413 !!    EXTERNAL
00414 !!    --------
00415 !!
00416 !!
00417 !!    IMPLICIT ARGUMENTS
00418 !!    ------------------
00419 !!
00420 !!    REFERENCE
00421 !!    ---------
00422 !!
00423 !!
00424 !!    AUTHOR
00425 !!    ------
00426 !!      F. Habets   *Meteo France*      
00427 !!
00428 !!    MODIFICATIONS
00429 !!    -------------
00430 !!      Original    08/03
00431 !-------------------------------------------------------------------------------
00432 !
00433 !*       0.    DECLARATIONS
00434 !              ------------
00435 !
00436 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00437 USE PARKIND1  ,ONLY : JPRB
00438 !
00439 IMPLICIT NONE
00440 !
00441 !*       0.1   Declarations of arguments
00442 !              -------------------------
00443 !
00444 INTEGER, DIMENSION(:),   INTENT(IN) :: KM
00445 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: P4D_IN
00446 REAL, DIMENSION(:,:,:,:), INTENT(OUT):: P4D_OUT
00447 !
00448 !*       0.2   Declarations of local variables
00449 !              -------------------------------
00450 !
00451 !
00452 INTEGER :: JI, JJ, JK, JL ! loop counter
00453 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00454 !
00455 !-------------------------------------------------------------------------------
00456 !
00457 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM4D',0,ZHOOK_HANDLE)
00458 DO JL=1,SIZE(P4D_OUT,4)
00459   DO JK=1,SIZE(P4D_OUT,3)
00460     DO JJ=1,SIZE(P4D_OUT,2)
00461 !cdir nodep
00462       DO JI=1,SIZE(P4D_OUT,1)
00463         P4D_OUT(JI,JJ,JL,JK) = P4D_IN(KM(JI),JJ,JL,JK)
00464       ENDDO
00465     ENDDO
00466   ENDDO
00467 ENDDO
00468 IF (LHOOK) CALL DR_HOOK('MODI_PACK_SAME_RANK:PACK_SAME_RANK_FROM4D',1,ZHOOK_HANDLE)
00469 !
00470 !-------------------------------------------------------------------------------
00471 !
00472 END SUBROUTINE PACK_SAME_RANK_FROM4D