- Timestamp:
- 2020-11-02T10:56:42+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Files:
-
- 6 edited
-
. (modified) (1 prop)
-
src/OCE/CRS/crs.F90 (modified) (8 diffs)
-
src/OCE/CRS/crsdom.F90 (modified) (47 diffs)
-
src/OCE/CRS/crsdomwri.F90 (modified) (5 diffs)
-
src/OCE/CRS/crsfld.F90 (modified) (12 diffs)
-
src/OCE/CRS/crsini.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/CRS/crs.F90
r10068 r13710 36 36 INTEGER :: jpiglo_full, jpjglo_full !: jpiglo / jpjglo 37 37 INTEGER :: npiglo, npjglo !: jpjglo 38 INTEGER :: nlci_full, nlcj_full !: i-, j-dimension of local or sub domain on parent grid 39 INTEGER :: nldi_full, nldj_full !: starting indices of internal sub-domain on parent grid 40 INTEGER :: nlei_full, nlej_full !: ending indices of internal sub-domain on parent grid 41 INTEGER :: nlci_crs, nlcj_crs !: i-, j-dimension of local or sub domain on coarse grid 42 INTEGER :: nldi_crs, nldj_crs !: starting indices of internal sub-domain on coarse grid 43 INTEGER :: nlei_crs, nlej_crs !: ending indices of internal sub-domain on coarse grid 38 INTEGER :: Nis0_full, Njs0_full !: starting indices of internal sub-domain on parent grid 39 INTEGER :: Nie0_full, Nje0_full !: ending indices of internal sub-domain on parent grid 40 INTEGER :: Nis0_crs , Njs0_crs !: starting indices of internal sub-domain on coarse grid 41 INTEGER :: Nie0_crs , Nje0_crs !: ending indices of internal sub-domain on coarse grid 44 42 45 43 INTEGER :: narea_full, narea_crs !: node … … 48 46 INTEGER :: nimpp_full, njmpp_full !: global position of point (1,1) of subdomain on parent grid 49 47 INTEGER :: nimpp_crs, njmpp_crs !: set to 1,1 for now . Valid only for monoproc 50 INTEGER :: nreci_full, nrecj_full51 INTEGER :: nreci_crs, nrecj_crs52 48 !cc 53 49 INTEGER :: noea_full, nowe_full !: index of the local neighboring processors in … … 76 72 INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs 77 73 INTEGER :: mxbinctr, mybinctr ! central point in grid box 78 INTEGER, DIMENSION(:), ALLOCATABLE :: nlcit_crs, nlcit_full!: dimensions of every subdomain79 INTEGER, DIMENSION(:), ALLOCATABLE :: n ldit_crs, nldit_full!: first, last indoor index for each i-domain80 INTEGER, DIMENSION(:), ALLOCATABLE :: n leit_crs, nleit_full!: first, last indoor index for each j-domain81 INTEGER, DIMENSION(:), ALLOCATABLE :: nimppt_crs, nimppt_full!: first, last indoor index for each j-domain82 INTEGER, DIMENSION(:), ALLOCATABLE :: nlcjt_crs, nlcjt_full!: dimensions of every subdomain83 INTEGER, DIMENSION(:), ALLOCATABLE :: n ldjt_crs, nldjt_full!: first, last indoor index for each i-domain84 INTEGER, DIMENSION(:), ALLOCATABLE :: n lejt_crs, nlejt_full!: first, last indoor index for each j-domain85 INTEGER, DIMENSION(:), ALLOCATABLE :: njmppt_crs, njmppt_full!: first, last indoor index for each j-domain74 INTEGER, DIMENSION(:), ALLOCATABLE :: jpiall_crs, jpiall_full !: dimensions of every subdomain 75 INTEGER, DIMENSION(:), ALLOCATABLE :: nis0all_crs, nis0all_full !: first, last indoor index for each i-domain 76 INTEGER, DIMENSION(:), ALLOCATABLE :: nie0all_crs, nie0all_full !: first, last indoor index for each j-domain 77 INTEGER, DIMENSION(:), ALLOCATABLE :: nimppt_crs, nimppt_full !: first, last indoor index for each j-domain 78 INTEGER, DIMENSION(:), ALLOCATABLE :: jpjall_crs, jpjall_full !: dimensions of every subdomain 79 INTEGER, DIMENSION(:), ALLOCATABLE :: njs0all_crs, njs0all_full !: first, last indoor index for each i-domain 80 INTEGER, DIMENSION(:), ALLOCATABLE :: nje0all_crs, nje0all_full !: first, last indoor index for each j-domain 81 INTEGER, DIMENSION(:), ALLOCATABLE :: njmppt_crs, njmppt_full !: first, last indoor index for each j-domain 86 82 87 83 88 84 ! Masks 89 85 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs 90 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 91 92 ! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmask_i_crs, tpol, fpol 93 86 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: rnfmsk_crs 87 94 88 ! Scale factors 95 89 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T … … 182 176 & umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2)) 183 177 184 ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs) , rnfmsk_crs(jpi_crs,jpj_crs), & 185 & tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) ) 178 ALLOCATE( rnfmsk_crs(jpi_crs,jpj_crs), STAT=ierr(3) ) 186 179 187 180 ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & … … 238 231 & hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 239 232 240 ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij), &241 & nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij), &242 njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij), &243 & njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij) , STAT=ierr(15) )233 ALLOCATE( nimppt_crs (jpnij) , jpiall_crs (jpnij) , nis0all_crs (jpnij) , nie0all_crs (jpnij), & 234 & nimppt_full(jpnij) , jpiall_full(jpnij) , nis0all_full(jpnij) , nie0all_full(jpnij), & 235 njmppt_crs (jpnij) , jpjall_crs (jpnij) , njs0all_crs (jpnij) , nje0all_crs (jpnij), & 236 & njmppt_full(jpnij) , jpjall_full(jpnij) , njs0all_full(jpnij) , nje0all_full(jpnij) , STAT=ierr(15) ) 244 237 245 238 crs_dom_alloc = MAXVAL(ierr) … … 258 251 ierr(:) = 0 259 252 260 ALLOCATE( mjs_crs( nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) )253 ALLOCATE( mjs_crs(Nje0_crs) , mje_crs(Nje0_crs), mis_crs(Nie0_crs) , mie_crs(Nie0_crs), STAT=ierr(1) ) 261 254 crs_dom_alloc2 = MAXVAL(ierr) 262 255 … … 282 275 jpjglo = jpjglo_full 283 276 284 nlci = nlci_full285 nlcj = nlcj_full286 nldi = nldi_full287 nldj = nldj_full288 nlei = nlei_full289 nlej = nlej_full290 nimpp 291 njmpp 292 293 nlcit(:) = nlcit_full(:)294 n ldit(:) = nldit_full(:)295 n leit(:) = nleit_full(:)296 nimppt (:) = nimppt_full(:)297 nlcjt(:) = nlcjt_full(:)298 n ldjt(:) = nldjt_full(:)299 n lejt(:) = nlejt_full(:)300 njmppt (:) = njmppt_full(:)277 jpi = jpi_full 278 jpj = jpj_full 279 Nis0 = Nis0_full 280 Njs0 = Njs0_full 281 Nie0 = Nie0_full 282 Nje0 = Nje0_full 283 nimpp = nimpp_full 284 njmpp = njmpp_full 285 286 jpiall (:) = jpiall_full (:) 287 nis0all(:) = nis0all_full(:) 288 nie0all(:) = nie0all_full(:) 289 nimppt (:) = nimppt_full (:) 290 jpjall (:) = jpjall_full (:) 291 njs0all(:) = njs0all_full(:) 292 nje0all(:) = nje0all_full(:) 293 njmppt (:) = njmppt_full (:) 301 294 302 295 END SUBROUTINE dom_grid_glo … … 322 315 323 316 324 nlci = nlci_crs325 nlcj = nlcj_crs326 nldi = nldi_crs327 nlei = nlei_crs328 nlej = nlej_crs329 nldj = nldj_crs330 nimpp 331 njmpp 332 333 nlcit(:) = nlcit_crs(:)334 n ldit(:) = nldit_crs(:)335 n leit(:) = nleit_crs(:)336 nimppt (:) = nimppt_crs(:)337 nlcjt(:) = nlcjt_crs(:)338 n ldjt(:) = nldjt_crs(:)339 n lejt(:) = nlejt_crs(:)340 njmppt (:) = njmppt_crs(:)317 jpi = jpi_crs 318 jpj = jpj_crs 319 Nis0 = Nis0_crs 320 Nie0 = Nie0_crs 321 Nje0 = Nje0_crs 322 Njs0 = Njs0_crs 323 nimpp = nimpp_crs 324 njmpp = njmpp_crs 325 326 jpiall (:) = jpiall_crs (:) 327 nis0all(:) = nis0all_crs(:) 328 nie0all(:) = nie0all_crs(:) 329 nimppt (:) = nimppt_crs (:) 330 jpjall (:) = jpjall_crs (:) 331 njs0all(:) = njs0all_crs(:) 332 nje0all(:) = nje0all_crs(:) 333 njmppt (:) = njmppt_crs (:) 341 334 ! 342 335 END SUBROUTINE dom_grid_crs -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/CRS/crsdom.F90
r11536 r13710 73 73 74 74 75 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA275 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 76 76 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 77 77 je_2 = mje_crs(2) ; ij = je_2 … … 81 81 ENDIF 82 82 DO jk = 1, jpkm1 83 DO ji = 2, nlei_crs83 DO ji = 2, Nie0_crs 84 84 ijis = mis_crs(ji) ; ijie = mie_crs(ji) 85 85 ! 86 86 zmask = 0.0 87 87 zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) ) 88 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 88 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0_wp 89 89 90 90 zmask = 0.0 91 91 zmask = SUM( vmask(ijis:ijie,je_2 ,jk) ) 92 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 92 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0_wp 93 93 94 94 zmask = 0.0 95 95 zmask = SUM(umask(ijie,ij:je_2,jk)) 96 IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 96 IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0_wp 97 97 98 98 fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk) … … 101 101 ! 102 102 DO jk = 1, jpkm1 103 DO ji = 2, nlei_crs103 DO ji = 2, Nie0_crs 104 104 ijis = mis_crs(ji) ; ijie = mie_crs(ji) 105 DO jj = 3, nlej_crs105 DO jj = 3, Nje0_crs 106 106 ijjs = mjs_crs(jj) ; ijje = mje_crs(jj) 107 107 108 108 zmask = 0.0 109 109 zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 110 IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 110 IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0_wp 111 111 112 112 zmask = 0.0 113 113 zmask = SUM( vmask(ijis:ijie,ijje ,jk) ) 114 IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 114 IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0_wp 115 115 116 116 zmask = 0.0 117 117 zmask = SUM( umask(ijie ,ijjs:ijje,jk) ) 118 IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 118 IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0_wp 119 119 120 120 fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) … … 124 124 125 125 ! 126 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )127 CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )128 CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )129 CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )126 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0_wp ) 127 CALL crs_lbc_lnk( vmask_crs, 'V', 1.0_wp ) 128 CALL crs_lbc_lnk( umask_crs, 'U', 1.0_wp ) 129 CALL crs_lbc_lnk( fmask_crs, 'F', 1.0_wp ) 130 130 ! 131 131 END SUBROUTINE crs_dom_msk … … 168 168 SELECT CASE ( cd_type ) 169 169 CASE ( 'T' ) 170 DO jj = nldj_crs, nlej_crs170 DO jj = Njs0_crs, Nje0_crs 171 171 ijjs = mjs_crs(jj) + mybinctr 172 DO ji = 2, nlei_crs172 DO ji = 2, Nie0_crs 173 173 ijis = mis_crs(ji) + mxbinctr 174 174 p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) … … 177 177 ENDDO 178 178 CASE ( 'U' ) 179 DO jj = nldj_crs, nlej_crs179 DO jj = Njs0_crs, Nje0_crs 180 180 ijjs = mjs_crs(jj) + mybinctr 181 DO ji = 2, nlei_crs181 DO ji = 2, Nie0_crs 182 182 ijis = mis_crs(ji) 183 183 p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) … … 186 186 ENDDO 187 187 CASE ( 'V' ) 188 DO jj = nldj_crs, nlej_crs188 DO jj = Njs0_crs, Nje0_crs 189 189 ijjs = mjs_crs(jj) 190 DO ji = 2, nlei_crs190 DO ji = 2, Nie0_crs 191 191 ijis = mis_crs(ji) + mxbinctr 192 192 p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) … … 195 195 ENDDO 196 196 CASE ( 'F' ) 197 DO jj = nldj_crs, nlej_crs197 DO jj = Njs0_crs, Nje0_crs 198 198 ijjs = mjs_crs(jj) 199 DO ji = 2, nlei_crs199 DO ji = 2, Nie0_crs 200 200 ijis = mis_crs(ji) 201 201 p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) … … 206 206 207 207 ! Retroactively add back the boundary halo cells. 208 CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 )209 CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )208 CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0_wp ) 209 CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0_wp ) 210 210 211 211 ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 212 212 SELECT CASE ( cd_type ) 213 213 CASE ( 'T', 'V' ) 214 DO ji = 2, nlei_crs214 DO ji = 2, Nie0_crs 215 215 ijis = mis_crs(ji) + mxbinctr 216 216 p_gphi_crs(ji,1) = p_gphi(ijis,1) … … 218 218 ENDDO 219 219 CASE ( 'U', 'F' ) 220 DO ji = 2, nlei_crs220 DO ji = 2, Nie0_crs 221 221 ijis = mis_crs(ji) 222 222 p_gphi_crs(ji,1) = p_gphi(ijis,1) … … 261 261 262 262 DO jk = 1, jpk 263 DO ji = 2, nlei_crs263 DO ji = 2, Nie0_crs 264 264 ijie = mie_crs(ji) 265 DO jj = nldj_crs, nlej_crs265 DO jj = Njs0_crs, Nje0_crs 266 266 ijje = mje_crs(jj) ; ijrs = mje_crs(jj) - mjs_crs(jj) 267 267 ! Only for a factro 3 coarsening … … 296 296 ENDDO 297 297 298 CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0 , pfillval=1.0)299 CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0 , pfillval=1.0)298 CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 299 CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 300 300 301 301 END SUBROUTINE crs_dom_hgr … … 374 374 ENDIF 375 375 376 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2376 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 377 377 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 378 378 je_2 = mje_crs(2) … … 440 440 ENDDO 441 441 ! ! Retroactively add back the boundary halo cells. 442 CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 )443 CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 )442 CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0_wp ) 443 CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0_wp ) 444 444 ! 445 445 ! … … 512 512 ENDIF 513 513 514 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2514 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 515 515 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 516 516 je_2 = mje_crs(2) … … 617 617 CASE( 'T', 'W' ) 618 618 619 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2619 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 620 620 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 621 621 je_2 = mje_crs(2) … … 674 674 CASE( 'V' ) 675 675 676 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2676 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 677 677 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 678 678 ijje = mje_crs(2) … … 711 711 CASE( 'U' ) 712 712 713 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2713 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 714 714 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 715 715 je_2 = mje_crs(2) … … 782 782 CASE( 'T', 'W' ) 783 783 784 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2784 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 785 785 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 786 786 je_2 = mje_crs(2) … … 842 842 CASE( 'V' ) 843 843 844 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2844 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 845 845 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 846 846 ijje = mje_crs(2) … … 883 883 CASE( 'U' ) 884 884 885 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2885 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 886 886 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 887 887 je_2 = mje_crs(2) … … 953 953 CASE( 'T', 'W' ) 954 954 955 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2955 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 956 956 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 957 957 je_2 = mje_crs(2) … … 1013 1013 CASE( 'V' ) 1014 1014 1015 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21015 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1016 1016 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1017 1017 ijje = mje_crs(2) … … 1053 1053 CASE( 'U' ) 1054 1054 1055 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21055 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1056 1056 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1057 1057 je_2 = mje_crs(2) … … 1158 1158 zsurfmsk(:,:) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 1159 1159 1160 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21160 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1161 1161 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1162 1162 je_2 = mje_crs(2) … … 1234 1234 CASE( 'T', 'W' ) 1235 1235 1236 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21236 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1237 1237 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1238 1238 je_2 = mje_crs(2) … … 1285 1285 CASE( 'V' ) 1286 1286 1287 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21287 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1288 1288 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1289 1289 ijje = mje_crs(2) … … 1318 1318 CASE( 'U' ) 1319 1319 1320 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21320 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1321 1321 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1322 1322 je_2 = mje_crs(2) … … 1369 1369 CASE( 'T', 'W' ) 1370 1370 1371 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21371 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1372 1372 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1373 1373 je_2 = mje_crs(2) … … 1420 1420 CASE( 'V' ) 1421 1421 1422 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21422 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1423 1423 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1424 1424 ijje = mje_crs(2) … … 1453 1453 CASE( 'U' ) 1454 1454 1455 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21455 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1456 1456 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1457 1457 je_2 = mje_crs(2) … … 1497 1497 CASE( 'T', 'W' ) 1498 1498 1499 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21499 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1500 1500 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1501 1501 je_2 = mje_crs(2) … … 1548 1548 CASE( 'V' ) 1549 1549 1550 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21550 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1551 1551 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1552 1552 ijje = mje_crs(2) … … 1581 1581 CASE( 'U' ) 1582 1582 1583 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21583 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1584 1584 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1585 1585 je_2 = mje_crs(2) … … 1665 1665 ENDDO 1666 1666 1667 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21667 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1668 1668 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1669 1669 je_2 = mje_crs(2) … … 1748 1748 ENDDO 1749 1749 1750 CALL crs_lbc_lnk( p_e3_crs , cd_type, 1.0 , pfillval=1.0)1751 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0 , pfillval=1.0)1750 CALL crs_lbc_lnk( p_e3_crs , cd_type, 1.0_wp, pfillval=1.0_wp ) 1751 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 1752 1752 ! 1753 1753 ! … … 1808 1808 END SELECT 1809 1809 1810 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21810 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1811 1811 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1812 1812 je_2 = mje_crs(2) … … 1857 1857 ENDDO 1858 1858 1859 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0 , pfillval=1.0)1860 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0 , pfillval=1.0)1859 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0_wp, pfillval=1.0_wp ) 1860 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0_wp, pfillval=1.0_wp ) 1861 1861 1862 1862 END SUBROUTINE crs_dom_sfc … … 1899 1899 ! 2.a Define processor domain 1900 1900 IF( .NOT. lk_mpp ) THEN 1901 nimpp_crs = 1 1902 njmpp_crs = 1 1903 nlci_crs = jpi_crs 1904 nlcj_crs = jpj_crs 1905 nldi_crs = 1 1906 nldj_crs = 1 1907 nlei_crs = jpi_crs 1908 nlej_crs = jpj_crs 1901 nimpp_crs = 1 1902 njmpp_crs = 1 1903 Nis0_crs = 1 1904 Njs0_crs = 1 1905 Nie0_crs = jpi_crs 1906 Nje0_crs = jpj_crs 1909 1907 ELSE 1910 1908 ! Initialisation of most local variables - 1911 nimpp_crs = 1 1912 njmpp_crs = 1 1913 nlci_crs = jpi_crs 1914 nlcj_crs = jpj_crs 1915 nldi_crs = 1 1916 nldj_crs = 1 1917 nlei_crs = jpi_crs 1918 nlej_crs = jpj_crs 1909 nimpp_crs = 1 1910 njmpp_crs = 1 1911 Nis0_crs = 1 1912 Njs0_crs = 1 1913 Nie0_crs = jpi_crs 1914 Nje0_crs = jpj_crs 1919 1915 1920 1916 ! Calculs suivant une découpage en j 1921 1917 DO jn = 1, jpnij, jpni 1922 1918 IF( jn < ( jpnij - jpni + 1 ) ) THEN 1923 n lejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn ) - 1) ) / nn_facty, wp ) ) &1919 nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn ) - 1) ) / nn_facty, wp ) ) & 1924 1920 & - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 1925 1921 ELSE 1926 n lejt_crs(jn) = AINT( REAL( nlejt(jn) / nn_facty, wp ) ) + 11922 nje0all_crs(jn) = AINT( REAL( nje0all(jn) / nn_facty, wp ) ) + 1 1927 1923 ENDIF 1928 IF( noso < 0 ) n lejt_crs(jn) = nlejt_crs(jn) + 11924 IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1 1929 1925 SELECT CASE( ibonjt(jn) ) 1930 1926 CASE ( -1 ) 1931 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 ) n lejt_crs(jn) = nlejt_crs(jn) + 11932 nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls1933 n ldjt_crs(jn) = nldjt(jn)1927 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1 1928 jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 1929 njs0all_crs(jn) = njs0all(jn) 1934 1930 1935 1931 CASE ( 0 ) 1936 1932 1937 n ldjt_crs(jn) = nldjt(jn)1938 IF( n ldjt(jn) == 1 ) nlejt_crs(jn) = nlejt_crs(jn) + 11939 n lejt_crs(jn) = nlejt_crs(jn) + nn_hls1940 nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls1933 njs0all_crs(jn) = njs0all(jn) 1934 IF( njs0all(jn) == 1 ) nje0all_crs(jn) = nje0all_crs(jn) + 1 1935 nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 1936 jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 1941 1937 1942 1938 CASE ( 1, 2 ) 1943 1939 1944 n lejt_crs(jn) = nlejt_crs(jn) + nn_hls1945 nlcjt_crs(jn) = nlejt_crs(jn)1946 n ldjt_crs(jn) = nldjt(jn)1940 nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 1941 jpjall_crs (jn) = nje0all_crs(jn) 1942 njs0all_crs(jn) = njs0all(jn) 1947 1943 1948 1944 CASE DEFAULT 1949 1945 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' ) 1950 1946 END SELECT 1951 IF( nlcjt_crs(jn) > jpj_crs ) jpj_crs = jpj_crs + 11952 1953 IF(n ldjt_crs(jn) == 1 ) THEN1947 IF( jpjall_crs(jn) > jpj_crs ) jpj_crs = jpj_crs + 1 1948 1949 IF(njs0all_crs(jn) == 1 ) THEN 1954 1950 njmppt_crs(jn) = 1 1955 1951 ELSE … … 1958 1954 1959 1955 DO jj = jn + 1, jn + jpni - 1 1960 n lejt_crs(jj) = nlejt_crs(jn)1961 nlcjt_crs(jj) = nlcjt_crs(jn)1962 n ldjt_crs(jj) = nldjt_crs(jn)1963 njmppt_crs (jj)= njmppt_crs(jn)1956 nje0all_crs(jj) = nje0all_crs(jn) 1957 jpjall_crs (jj) = jpjall_crs(jn) 1958 njs0all_crs(jj) = njs0all_crs(jn) 1959 njmppt_crs (jj) = njmppt_crs(jn) 1964 1960 ENDDO 1965 1961 ENDDO 1966 nlej_crs = nlejt_crs(nproc + 1)1967 nlcj_crs = nlcjt_crs(nproc + 1)1968 nldj_crs = nldjt_crs(nproc + 1)1969 njmpp_crs = njmppt_crs (nproc + 1)1962 Nje0_crs = nje0all_crs(nproc + 1) 1963 jpj_crs = jpjall_crs (nproc + 1) 1964 Njs0_crs = njs0all_crs(nproc + 1) 1965 njmpp_crs = njmppt_crs (nproc + 1) 1970 1966 1971 1967 ! Calcul suivant un decoupage en i 1972 1968 DO jn = 1, jpni 1973 1969 IF( jn == 1 ) THEN 1974 n leit_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + nlcit(jn ) ) / nn_factx, wp) )1970 nie0all_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + jpiall(jn ) ) / nn_factx, wp) ) 1975 1971 ELSE 1976 n leit_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + nlcit(jn ) ) / nn_factx, wp) ) &1977 & - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) ) / nn_factx, wp) )1972 nie0all_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + jpiall(jn ) ) / nn_factx, wp) ) & 1973 & - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) ) / nn_factx, wp) ) 1978 1974 ENDIF 1979 1975 1980 1976 SELECT CASE( ibonit(jn) ) 1981 1977 CASE ( -1 ) 1982 n leit_crs(jn) = nleit_crs(jn) + nn_hls1983 nlcit_crs(jn) = nleit_crs(jn) + nn_hls1984 n ldit_crs(jn) = nldit(jn)1978 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 1979 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 1980 nis0all_crs(jn) = nis0all(jn) 1985 1981 1986 1982 CASE ( 0 ) 1987 n leit_crs(jn) = nleit_crs(jn) + nn_hls1988 nlcit_crs(jn) = nleit_crs(jn) + nn_hls1989 n ldit_crs(jn) = nldit(jn)1983 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 1984 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 1985 nis0all_crs(jn) = nis0all(jn) 1990 1986 1991 1987 CASE ( 1, 2 ) 1992 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 ) n leit_crs(jn) = nleit_crs(jn) + 11993 n leit_crs(jn) = nleit_crs(jn) + nn_hls1994 nlcit_crs(jn) = nleit_crs(jn)1995 n ldit_crs(jn) = nldit(jn)1988 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 ) nie0all_crs(jn) = nie0all_crs(jn) + 1 1989 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 1990 jpiall_crs (jn) = nie0all_crs(jn) 1991 nis0all_crs(jn) = nis0all(jn) 1996 1992 1997 1993 CASE DEFAULT … … 2001 1997 nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 2002 1998 DO jj = jn + jpni , jpnij, jpni 2003 n leit_crs(jj) = nleit_crs(jn)2004 nlcit_crs(jj) = nlcit_crs(jn)2005 n ldit_crs(jj) = nldit_crs(jn)2006 nimppt_crs (jj)= nimppt_crs(jn)1999 nie0all_crs(jj) = nie0all_crs(jn) 2000 jpiall_crs (jj) = jpiall_crs (jn) 2001 nis0all_crs(jj) = nis0all_crs(jn) 2002 nimppt_crs (jj) = nimppt_crs (jn) 2007 2003 ENDDO 2008 2004 ENDDO 2009 2005 2010 nlei_crs = nleit_crs(nproc + 1)2011 nlci_crs = nlcit_crs(nproc + 1)2012 nldi_crs = nldit_crs(nproc + 1)2013 nimpp_crs = nimppt_crs (nproc + 1)2006 Nie0_crs = nie0all_crs(nproc + 1) 2007 jpi_crs = jpiall_crs (nproc + 1) 2008 Nis0_crs = nis0all_crs(nproc + 1) 2009 nimpp_crs = nimppt_crs (nproc + 1) 2014 2010 2015 2011 DO ji = 1, jpi_crs … … 2043 2039 jpjglo_full = jpjglo 2044 2040 2045 nlcj_full = nlcj2046 nlci_full = nlci2047 nldi_full = nldi2048 nldj_full = nldj2049 nlei_full = nlei2050 nlej_full = nlej2051 nimpp_full 2052 njmpp_full 2041 jpj_full = jpj 2042 jpi_full = jpi 2043 Nis0_full = Nis0 2044 Njs0_full = Njs0 2045 Nie0_full = Nie0 2046 Nje0_full = Nje0 2047 nimpp_full = nimpp 2048 njmpp_full = njmpp 2053 2049 2054 nlcit_full(:) = nlcit(:)2055 n ldit_full(:) = nldit(:)2056 n leit_full(:) = nleit(:)2057 nimppt_full (:) = nimppt(:)2058 nlcjt_full(:) = nlcjt(:)2059 n ldjt_full(:) = nldjt(:)2060 n lejt_full(:) = nlejt(:)2061 njmppt_full (:) = njmppt(:)2050 jpiall_full (:) = jpiall (:) 2051 nis0all_full(:) = nis0all(:) 2052 nie0all_full(:) = nie0all(:) 2053 nimppt_full (:) = nimppt (:) 2054 jpjall_full (:) = jpjall (:) 2055 njs0all_full(:) = njs0all(:) 2056 nje0all_full(:) = nje0all(:) 2057 njmppt_full (:) = njmppt (:) 2062 2058 2063 2059 CALL dom_grid_crs !swich de grille … … 2073 2069 WRITE(numout,*) 2074 2070 WRITE(numout,*) ' nproc = ' , nproc 2075 WRITE(numout,*) ' nlci = ' , nlci2076 WRITE(numout,*) ' nlcj = ' , nlcj2077 WRITE(numout,*) ' nldi = ' , nldi2078 WRITE(numout,*) ' nldj = ' , nldj2079 WRITE(numout,*) ' nlei = ' , nlei2080 WRITE(numout,*) ' nlej = ' , nlej2081 WRITE(numout,*) ' nlei_full=' , nlei_full2082 WRITE(numout,*) ' nldi_full=' , nldi_full2071 WRITE(numout,*) ' jpi = ' , jpi 2072 WRITE(numout,*) ' jpj = ' , jpj 2073 WRITE(numout,*) ' Nis0 = ' , Nis0 2074 WRITE(numout,*) ' Njs0 = ' , Njs0 2075 WRITE(numout,*) ' Nie0 = ' , Nie0 2076 WRITE(numout,*) ' Nje0 = ' , Nje0 2077 WRITE(numout,*) ' Nie0_full=' , Nie0_full 2078 WRITE(numout,*) ' Nis0_full=' , Nis0_full 2083 2079 WRITE(numout,*) ' nimpp = ' , nimpp 2084 2080 WRITE(numout,*) ' njmpp = ' , njmpp … … 2203 2199 mje_crs(:) = mje2_crs(:) 2204 2200 ELSE 2205 DO jj = 1, nlej_crs2201 DO jj = 1, Nje0_crs 2206 2202 mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 2207 2203 mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 2208 2204 ENDDO 2209 DO ji = 1, nlei_crs2205 DO ji = 1, Nie0_crs 2210 2206 mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 2211 2207 mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 … … 2213 2209 ENDIF 2214 2210 ! 2215 nistr = mis_crs(2) ; niend = mis_crs( nlci_crs - 1)2216 njstr = mjs_crs(3) ; njend = mjs_crs( nlcj_crs - 1)2211 nistr = mis_crs(2) ; niend = mis_crs(jpi_crs - 1) 2212 njstr = mjs_crs(3) ; njend = mjs_crs(jpj_crs - 1) 2217 2213 ! 2218 2214 END SUBROUTINE crs_dom_def … … 2246 2242 2247 2243 zmbk(:,:) = 0.0 2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0 ) ; mbathy_crs(:,:) = NINT( zmbk(:,:) )2244 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0_wp) ; mbathy_crs(:,:) = NINT( zmbk(:,:) ) 2249 2245 2250 2246 … … 2266 2262 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 2267 2263 zmbk(:,:) = 1.e0; 2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0 ) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 )2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0 ) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 )2264 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0_wp) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2265 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0_wp) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2270 2266 ! 2271 2267 END SUBROUTINE crs_dom_bat -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/CRS/crsdomwri.F90
r12377 r13710 50 50 INTEGER :: ji, jj, jk ! dummy loop indices 51 51 INTEGER :: inum ! local units for 'mesh_mask.nc' file 52 INTEGER :: iif, iil, ijf, ijl53 52 CHARACTER(len=21) :: clnam ! filename (mesh and mask informations) 54 53 ! ! workspace … … 76 75 CALL iom_rstput( 0, 0, inum, 'fmask', fmask_crs, ktype = jp_i1 ) 77 76 78 79 tmask_i_crs(:,:) = tmask_crs(:,:,1) 80 iif = nn_hls 81 iil = nlci_crs - nn_hls + 1 82 ijf = nn_hls 83 ijl = nlcj_crs - nn_hls + 1 84 85 tmask_i_crs( 1:iif , : ) = 0._wp 86 tmask_i_crs(iil:jpi_crs, : ) = 0._wp 87 tmask_i_crs( : , 1:ijf ) = 0._wp 88 tmask_i_crs( : ,ijl:jpj_crs) = 0._wp 89 90 91 tpol_crs(1:jpiglo_crs,:) = 1._wp 92 fpol_crs(1:jpiglo_crs,:) = 1._wp 93 IF( jperio == 3 .OR. jperio == 4 ) THEN 94 tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp 95 fpol_crs( 1 :jpiglo_crs,:) = 0._wp 96 IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN 97 DO ji = iif+1, iil-1 98 tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) & 99 & * tpol_crs(mig_crs(ji),1) 100 ENDDO 101 ENDIF 102 ENDIF 103 IF( jperio == 5 .OR. jperio == 6 ) THEN 104 tpol_crs( 1 :jpiglo_crs,:)=0._wp 105 fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp 106 ENDIF 107 108 CALL iom_rstput( 0, 0, inum, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 109 ! ! unique point mask 77 CALL dom_uniq_crs( zprw, 'T' ) 78 zprt = tmask_crs(:,:,1) * zprw 79 CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 ) 110 80 CALL dom_uniq_crs( zprw, 'U' ) 111 81 zprt = umask_crs(:,:,1) * zprw … … 161 131 END DO 162 132 END DO 163 CALL crs_lbc_lnk( zdepu,'U', 1. ) ; CALL crs_lbc_lnk( zdepv,'V', 1.)133 CALL crs_lbc_lnk( zdepu,'U', 1.0_wp ) ; CALL crs_lbc_lnk( zdepv,'V', 1.0_wp ) 164 134 ! 165 135 CALL iom_rstput( 0, 0, inum, 'gdepu', zdepu, ktype = jp_r4 ) … … 211 181 REAL(wp) :: zshift ! shift value link to the process number 212 182 INTEGER :: ji ! dummy loop indices 213 LOGICAL , DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl! store whether each point is unique or not214 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) ::ztstref183 LOGICAL , DIMENSION(jpi_crs,jpj_crs,1) :: lluniq ! store whether each point is unique or not 184 REAL(wp), DIMENSION(jpi_crs,jpj_crs ) :: ztstref 215 185 !!---------------------------------------------------------------------- 216 186 ! … … 218 188 ! in mpp: make sure that these values are different even between process 219 189 ! -> apply a shift value according to the process number 220 zshift = jpi_crs * jpj_crs * ( narea - 1 )190 zshift = (jpi_crs+1.) * (jpj_crs+1.) * ( narea - 1 ) ! we should use jpimax_crs but not existing 221 191 ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) ) 222 192 ! 223 193 puniq(:,:) = ztstref(:,:) ! default definition 224 CALL crs_lbc_lnk( puniq,cdgrd, 1. ) ! apply boundary conditions 225 lldbl(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have been changed 226 ! 227 puniq(:,:) = 1. ! default definition 228 ! fill only the inner part of the cpu with llbl converted into real 229 puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 194 CALL crs_lbc_lnk( puniq,cdgrd, 1.0_wp ) ! apply boundary conditions 195 lluniq(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have been changed 196 ! 197 puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 230 198 ! 231 199 END SUBROUTINE dom_uniq_crs -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/CRS/crsfld.F90
r12377 r13710 33 33 !! * Substitutions 34 34 # include "do_loop_substitute.h90" 35 # include "domzgr_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 68 69 69 70 ! Depth work arrrays 70 ze3t(:,:,:) = e3t(:,:,:,Kmm) 71 ze3u(:,:,:) = e3u(:,:,:,Kmm) 72 ze3v(:,:,:) = e3v(:,:,:,Kmm) 73 ze3w(:,:,:) = e3w(:,:,:,Kmm) 71 DO jk = 1 , jpk 72 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 73 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 74 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 75 ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 76 END DO 74 77 75 78 IF( kt == nit000 ) THEN … … 98 101 ! Temperature 99 102 zt(:,:,:) = ts(:,:,:,jp_tem,Kmm) ; zt_crs(:,:,:) = 0._wp 100 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )103 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 101 104 tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 102 105 … … 107 110 ! Salinity 108 111 zs(:,:,:) = ts(:,:,:,jp_sal,Kmm) ; zs_crs(:,:,:) = 0._wp 109 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )112 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 110 113 tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 111 114 … … 114 117 115 118 ! U-velocity 116 CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )119 CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 117 120 ! 118 121 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 119 DO_3D _00_00(1, jpkm1 )122 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 120 123 zt(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 121 124 zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 122 125 END_3D 123 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )124 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )126 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 127 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 125 128 126 129 CALL iom_put( "uoce" , un_crs ) ! i-current … … 129 132 130 133 ! V-velocity 131 CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )134 CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 132 135 ! 133 136 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 134 DO_3D _00_00(1, jpkm1 )137 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 135 138 zt(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 136 139 zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 137 140 END_3D 138 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )139 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )141 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 142 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 140 143 141 144 CALL iom_put( "voce" , vn_crs ) ! i-current … … 143 146 CALL iom_put( "voces" , zs_crs ) ! vS 144 147 145 IF( iom_use( " eken") ) THEN ! kinetic energy148 IF( iom_use( "ke") ) THEN ! kinetic energy 146 149 z3d(:,:,jk) = 0._wp 147 DO_3D _00_00(1, jpkm1 )150 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 148 151 zztmp = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 149 152 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & … … 153 156 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 154 157 END_3D 155 CALL lbc_lnk( 'crsfld', z3d, 'T', 1. )158 CALL lbc_lnk( 'crsfld', z3d, 'T', 1.0_wp ) 156 159 ! 157 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )158 CALL iom_put( " eken", zt_crs )160 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 161 CALL iom_put( "ke", zt_crs ) 159 162 ENDIF 160 163 ! Horizontal divergence ( following OCE/DYN/divhor.F90 ) … … 173 176 END DO 174 177 END DO 175 CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )178 CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0_wp ) 176 179 ! 177 180 CALL iom_put( "hdiv", hdivn_crs ) … … 180 183 ! W-velocity 181 184 IF( ln_crs_wn ) THEN 182 CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )185 CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 183 186 ! CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 184 187 ELSE … … 194 197 SELECT CASE ( nn_crs_kz ) 195 198 CASE ( 0 ) 196 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )197 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )199 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 200 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 198 201 CASE ( 1 ) 199 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )200 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )202 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 203 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 201 204 CASE ( 2 ) 202 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )203 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )205 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 206 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 204 207 END SELECT 205 208 ! … … 208 211 209 212 ! sbc fields 210 CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0 )211 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 )212 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 )213 CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )214 CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0 )215 CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )216 CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )217 CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )218 CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )219 CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )213 CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp ) 214 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0_wp ) 215 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp ) 216 CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 217 CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp ) 218 CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 219 CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 220 CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 221 CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 222 CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 220 223 221 224 CALL iom_put( "ssh" , sshn_crs ) ! ssh output -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/CRS/crsini.F90
r12377 r13710 28 28 PUBLIC crs_init ! called by nemogcm.F90 module 29 29 30 !! * Substitutions 31 # include "domzgr_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 174 176 175 177 ! 176 ze3t(:,:,:) = e3t(:,:,:,Kmm) 177 ze3u(:,:,:) = e3u(:,:,:,Kmm) 178 ze3v(:,:,:) = e3v(:,:,:,Kmm) 179 ze3w(:,:,:) = e3w(:,:,:,Kmm) 178 DO jk = 1, jpk 179 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 180 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 181 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 182 ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 183 END DO 180 184 181 185 ! 3.d.2 Surfaces … … 207 211 208 212 ! 3.d.3 Vertical depth (meters) 209 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 )210 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 )213 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0_wp ) 214 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0_wp ) 211 215 212 216
Note: See TracChangeset
for help on using the changeset viewer.
