- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/CRS/crsdom.F90 (modified) (47 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- 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@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/CRS/crsdom.F90
r11536 r13540 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
Note: See TracChangeset
for help on using the changeset viewer.
