Changeset 7215 for branches/2015/dev_r5003_MERCATOR6_CRS
- Timestamp:
- 2016-11-09T17:41:16+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r7210 r7215 8 8 !!---------------------------------------------------------------------- 9 9 USE par_oce 10 USE par_trc11 10 USE dom_oce 12 11 USE in_out_manager … … 174 173 ! 175 174 ! Surface fluxes to pass to TOP 176 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs ,qsr_mean_crs175 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs 177 176 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs 178 177 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: fmmflx_crs 179 178 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs 180 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: rnf_crs,rnf_b_crs,h_rnf_crs 181 INTEGER , PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: nk_rnf_crs 179 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: rnf_crs,rnf_b_crs 182 180 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_i_crs,trc_o_crs 183 184 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: etot3_crs 185 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: uslp_crs, wslpi_crs !: i_slope at U- and W-points186 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: vslp_crs, wslpj_crs !: j-slope at V- and W-points181 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sbc_trc_crs, sbc_trc_b_crs 182 183 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: uslp_crs, wslpi_crs !: i_slope at U- and W-points 184 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: vslp_crs, wslpj_crs !: j-slope at V- and W-points 187 185 188 186 ! Horizontal diffusion … … 317 315 ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs), ssha_crs(jpi_crs,jpj_crs), & 318 316 & qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 319 & qsr_mean_crs(jpi_crs ,jpj_crs) , &320 317 & vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs), & 321 318 & rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), & 322 & h_rnf_crs(jpi_crs,jpj_crs), nk_rnf_crs(jpi_crs ,jpj_crs), &323 319 & emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 324 & etot3_crs(jpi_crs,jpj_crs,jpk), &325 & trc_i_crs (jpi_crs,jpj_crs,jpt ra), trc_o_crs(jpi_crs,jpj_crs,jptra), &320 & sbc_trc_crs (jpi_crs,jpj_crs,jpts), sbc_trc_b_crs(jpi_crs,jpj_crs,jpts), & 321 & trc_i_crs (jpi_crs,jpj_crs,jpts), trc_o_crs(jpi_crs,jpj_crs,jpts), & 326 322 & fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) ) 327 323 -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r7210 r7215 101 101 102 102 fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) 103 104 103 105 104 ENDDO … … 1199 1198 ENDDO 1200 1199 1201 WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 1202 WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 1203 WRITE(narea+8000-1,*)"jpni jpnj ",jpni,jpnj 1204 WRITE(narea+8000-1,*)"nowe noea",nowe,noea 1205 WRITE(narea+8000-1,*)"noso nono",noso,nono 1206 WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 1207 WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 1208 WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 1209 WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 1210 WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 1211 WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi ,nlei ,nlci 1212 WRITE(narea+8000-1,*)"glo jpi nldi,nlei ",jpi, nldi+nimpp-1,nlei+nimpp-1 1213 WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj ,nlej ,nlcj 1214 WRITE(narea+8000-1,*)"glo jpj nldj,nlej ",jpj, nldj+njmpp-1,nlej+njmpp-1 1215 WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 1216 WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 1217 WRITE(narea+8000-1,*)"jpni jpnj jpnij ",jpni,jpnj,jpnij 1218 WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 1200 !WRITE(narea+8000-1,*)"nfipproc(ji,jj),narea :",nfipproc(iproci,iprocj),narea 1201 !WRITE(narea+8000-1,*)"proc i,j ",iproci,iprocj 1202 !WRITE(narea+8000-1,*)"nowe noea",nowe,noea 1203 !WRITE(narea+8000-1,*)"noso nono",noso,nono 1204 !WRITE(narea+8000-1,*)"nbondi nbondj ",nbondi,nbondj 1205 !WRITE(narea+8000-1,*)"jpiglo jpjglo ",jpiglo,jpjglo 1206 !WRITE(narea+8000-1,*)"jpi jpj ",jpi,jpj 1207 !WRITE(narea+8000-1,*)"nbondi nbondj",nbondi,nbondj 1208 !WRITE(narea+8000-1,*)"nimpp njmpp ",nimpp,njmpp 1209 !WRITE(narea+8000-1,*)"loc jpi nldi,nlei,nlci ",jpi, nldi ,nlei ,nlci 1210 !WRITE(narea+8000-1,*)"glo jpi nldi,nlei ",jpi, nldi+nimpp-1,nlei+nimpp-1 1211 !WRITE(narea+8000-1,*)"loc jpj nldj,nlej,nlcj ",jpj, nldj ,nlej ,nlcj 1212 !WRITE(narea+8000-1,*)"glo jpj nldj,nlej ",jpj, nldj+njmpp-1,nlej+njmpp-1 1213 !WRITE(narea+8000-1,*)"jpiglo_crs jpjglo_crs ",jpiglo_crs,jpjglo_crs 1214 !WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 1215 !WRITE(narea+8000-1,*)"jpni jpnj jpnij ",jpni,jpnj,jpnij 1216 !WRITE(narea+8000-1,*)"glamt gphit ",glamt(1,1),gphit(jpi,jpj),glamt(jpi,jpj),gphit(jpi,jpj) 1219 1217 !========================================================================== 1220 1218 ! dim along I … … 1228 1226 mis2_crs(ji)=ijis 1229 1227 mie2_crs(ji)=ijie 1230 WRITE(narea+8000-1,*)"ji",ji,mis2_crs(ji),mie2_crs(ji),mis2_crs(ji)-nimpp+1,mie2_crs(ji)-nimpp+11231 1228 ENDDO 1232 1229 … … 1243 1240 ii_start = mis2_crs(ijis)-nimpp+1 1244 1241 nimpp_crs = ijis-1 1245 WRITE(narea+8000-1,*)"ii_start = ",ii_start , mis2_crs(ijis), nimpp1246 1242 1247 1243 nldi_crs = 2 … … 1271 1267 IF( nimpp==1 )nimpp_crs=1 1272 1268 1273 IF( iproci == 1 )THEN1274 nldi_crs=11275 nimpp_crs=11276 ENDIF1277 1278 1269 !---------------------------------------- 1279 1270 ji=jpiglo_crs 1280 DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. nlci )1271 DO WHILE( mie2_crs(ji) - nimpp + 1 .GT. jpi ) 1281 1272 ji=ji-1 1282 1273 IF( ji==1 )EXIT 1283 1274 END DO 1284 WRITE(narea+8000-1,*)"=> mie2_crs ",ji,mie2_crs(ji), mie2_crs(ji) - nimpp + 11285 1275 ijie=ji 1286 1276 nlei_crs=ijie-nimpp_crs+1 … … 1300 1290 mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 1301 1291 mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 1302 nfactx(ji) = mie_crs(ji)-mi s_crs(ji)+11292 nfactx(ji) = mie_crs(ji)-mie_crs(ji)+1 1303 1293 ENDDO 1304 1294 1305 1295 IF( iproci == jpni )THEN 1306 1296 nlei_crs=nlci_crs 1307 ji=nlei_crs 1308 mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 1309 mie_crs(ji) = nlei 1310 mie2_crs(mig_crs(ji)) = nlei + nimpp -1 1311 nfactx(ji) = mie_crs(ji)-mis_crs(ji)+1 1297 mis_crs(nlei_crs)=mis_crs(nlei_crs-1) 1298 mie_crs(nlei_crs)=mie_crs(nlei_crs-1) 1312 1299 ENDIF 1313 1314 DO ji = 1, nlei_crs1315 WRITE(narea+8000-1,'(A4,7(1X,I4))')"loc ",ji,mig_crs(ji),mis2_crs(mig_crs(ji)),mie2_crs(mig_crs(ji)),mis_crs(ji),mie_crs(ji),nfactx(ji)1316 ENDDO1317 1300 1318 1301 !---------------------------------------- … … 1404 1387 mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 1405 1388 mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 1406 nfacty(jj) = mje_crs(jj)-mjs_crs(jj)+11389 nfacty(jj) = mje_crs(jj)-mje_crs(jj)+1 1407 1390 ENDDO 1408 IF( nono==-1 )THEn1409 nlej_crs = nlcj_crs1410 mjs_crs(nlej_crs) = mjs2_crs(mjg_crs(nlej_crs)) - njmpp + 11411 mje_crs(nlej_crs) = nlcj1412 nfacty(jj) = mje_crs(jj)-mjs_crs(jj)+11413 ENDIF1414 1391 1415 1392 IF( iprocj == jpnj )THEN 1416 mjs_crs(nlej_crs) = mjs_crs(nlej_crs-1) 1417 mje_crs(nlej_crs) = mje_crs(nlej_crs-1) 1418 nfacty(nlej_crs) = mje_crs(nlej_crs)-mjs_crs(nlej_crs)+1 1393 mjs_crs(nlej_crs)=mjs_crs(nlej_crs-1) 1394 mje_crs(nlej_crs)=mje_crs(nlej_crs-1) 1419 1395 ENDIF 1420 1396 1421 DO jj = 1, nlej_crs1422 WRITE(narea+8000-1,'(A4,7(1X,I4))')"loc ",jj,mjg_crs(jj),mjs2_crs(mjg_crs(jj)),mje2_crs(mjg_crs(jj)),mjs_crs(jj),mje_crs(jj),nfacty(jj)1423 ENDDO1424 1397 !---------------------------------------- 1425 1398 … … 1466 1439 END DO 1467 1440 1468 WRITE(narea+8000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs ,nlei_crs ,nlci_crs 1469 WRITE(narea+8000-1,*)"glo crs jpi nldi,nlei ",jpi_crs, nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 1470 WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs ,nlej_crs ,nlcj_crs 1471 WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 1472 WRITE(narea+8000-1,*)"jpi_crs jpj_crs ",jpi_crs,jpj_crs 1473 WRITE(narea+8000-1,*)"nimpp_crs njmpp_crs ",nimpp_crs,njmpp_crs 1474 1475 WRITE(narea+8000-1,*)"min max tmask ",MINVAL(tmask),MAXVAL(tmask) 1476 1477 IF( jpi_crs .LE. 0 ) WRITE(narea+8000-1,*)"BUG jpi_crs" 1478 IF( jpj_crs .LE. 0 ) WRITE(narea+8000-1,*)"BUG jpj_crs" 1479 IF( nldi_crs .LE. 0 ) WRITE(narea+8000-1,*)"BUG nldi_crs" 1480 IF( nldj_crs .LE. 0 ) WRITE(narea+8000-1,*)"BUG nldj_crs" 1481 IF( nlei_crs .GT. jpi_crs ) WRITE(narea+8000-1,*)"BUG nlei_crs" 1482 IF( nlej_crs .GT. jpj_crs ) WRITE(narea+8000-1,*)"BUG nlej_crs" 1483 IF( nimpp_crs .LE. 0 .OR. nimpp_crs .GT. jpiglo_crs) WRITE(narea+8000-1,*)"BUG nimpp_crs",nimpp_crs 1484 IF( njmpp_crs .LE. 0 .OR. njmpp_crs .GT. jpjglo_crs) WRITE(narea+8000-1,*)"BUG njmpp_crs",njmpp_crs 1485 CALL FLUSh(narea+8000-1) 1486 1487 DO ji=1,nlei_crs 1488 IF( ji+nimpp_crs-1 .GT. jpiglo_crs )WRITE(narea+8000-1,*)"BUG ji+nimpp_crs-1 .GT. jpiglo_crs ",ji,ji+nimpp_crs-1 1489 ENDDO 1490 DO jj=1,nlej_crs 1491 IF( jj+njmpp_crs-1 .GT. jpjglo_crs )WRITE(narea+8000-1,*)"BUG jj+njmpp_crs-1 .GT. jpjglo_crs ",jj,jj+njmpp_crs-1 1492 ENDDO 1441 !WRITE(narea+8000-1,*)"loc crs jpi nldi,nlei,nlci ",jpi_crs, nldi_crs ,nlei_crs ,nlci_crs 1442 !WRITE(narea+8000-1,*)"glo crs jpi nldi,nlei ",jpi_crs, nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 1443 !WRITE(narea+8000-1,*)"loc crs jpj nldj,nlej,nlcj ",jpj_crs, nldj_crs ,nlej_crs ,nlcj_crs 1444 !WRITE(narea+8000-1,*)"glo crs jpj nldj,nlej ",jpj_crs, nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 1493 1445 !============================================================================================== 1494 1446 IF( jpizoom /= 1 .OR. jpjzoom /= 1) STOP -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r7210 r7215 15 15 USE ldftra_oce ! ocean active tracers: lateral physics 16 16 USE sbc_oce ! Surface boundary condition: ocean fields 17 USE sbcrnf18 17 USE zdf_oce ! vertical physics: ocean fields 19 18 USE zdfddm ! vertical physics: double diffusion … … 34 33 USE zdftke 35 34 USE zdftke_crs 36 USE trc, ONLY: qsr_mean 35 37 36 USE ieee_arithmetic 38 37 … … 227 226 CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=zs_crs, p_e3_max_crs=e3v_max_n_crs) 228 227 229 DO jk = 1, jpk 230 DO ji = 1, jpi_crs 231 DO jj = 1, jpj_crs 232 IF( e3t_n_crs(ji,jj,jk) == 0._wp ) e3t_n_crs(ji,jj,jk) = e3t_1d(jk) 233 IF( e3w_n_crs(ji,jj,jk) == 0._wp ) e3w_n_crs(ji,jj,jk) = e3w_1d(jk) 234 IF( e3u_n_crs(ji,jj,jk) == 0._wp ) e3u_n_crs(ji,jj,jk) = e3t_1d(jk) 235 IF( e3v_n_crs(ji,jj,jk) == 0._wp ) e3v_n_crs(ji,jj,jk) = e3t_1d(jk) 236 IF( e3t_max_n_crs(ji,jj,jk) == 0._wp ) e3t_max_n_crs(ji,jj,jk) = e3t_1d(jk) 237 IF( e3w_max_n_crs(ji,jj,jk) == 0._wp ) e3w_max_n_crs(ji,jj,jk) = e3w_1d(jk) 238 IF( e3u_max_n_crs(ji,jj,jk) == 0._wp ) e3u_max_n_crs(ji,jj,jk) = e3t_1d(jk) 239 IF( e3v_max_n_crs(ji,jj,jk) == 0._wp ) e3v_max_n_crs(ji,jj,jk) = e3t_1d(jk) 240 ENDDO 241 ENDDO 242 ENDDO 228 WHERE(e3t_max_n_crs == 0._wp) e3t_max_n_crs=r_inf 229 WHERE(e3u_max_n_crs == 0._wp) e3u_max_n_crs=r_inf 230 WHERE(e3v_max_n_crs == 0._wp) e3v_max_n_crs=r_inf 231 WHERE(e3w_max_n_crs == 0._wp) e3w_max_n_crs=r_inf 243 232 244 233 CALL crs_dom_ope( gdepw_n, 'MAX', 'T', tmask, gdept_n_crs, p_e3=zfse3t, psgn=1.0 ) 245 234 CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 ) 246 DO jk = 1, jpk247 DO ji = 1, jpi_crs248 DO jj = 1, jpj_crs249 IF( gdept_n_crs(ji,jj,jk) .LE. 0._wp ) gdept_n_crs(ji,jj,jk) = gdept_1d(jk)250 IF( gdepw_n_crs(ji,jj,jk) .LE. 0._wp ) gdepw_n_crs(ji,jj,jk) = gdepw_1d(jk)251 ENDDO252 ENDDO253 ENDDO254 zmin=MINVAL(gdept_n_crs);zmax=MAXVAL(gdept_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld gdept_n_crs",zmin,zmax255 zmin=MINVAL(gdepw_n_crs);zmax=MAXVAL(gdepw_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld gdepw_n_crs",zmin,zmax256 235 257 236 CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t ) … … 346 325 CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 347 326 CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0 ) 348 CALL crs_dom_ope( h_rnf, 'MAX', 'T', tmask, h_rnf_crs , psgn=1.0 )349 z2d=REAL(nk_rnf,wp)350 CALL crs_dom_ope( z2d , 'MAX', 'T', tmask, z2d_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )351 nk_rnf_crs=INT(z2d_crs)352 327 CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 353 354 !???#if defined key_vvl 355 ! CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 ) 356 !#else 357 ! CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 ) 358 !#endif 328 #if defined key_vvl 329 CALL crs_dom_ope( gdepw_n, 'MAX', 'W', tmask, gdepw_n_crs, p_e3=zfse3w, psgn=1.0 ) 330 #else 331 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 ) 332 #endif 359 333 CALL crs_dom_ope( emp ,'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 360 334 CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) … … 438 412 zmin=MINVAL(e3t_n_crs);zmax=MAXVAL(e3t_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_n_crs",zmin,zmax 439 413 zmin=MINVAL(e3t_a_crs);zmax=MAXVAL(e3t_a_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_a_crs",zmin,zmax 440 zmin=MINVAL(e3t_max_n_crs);zmax=MAXVAL(e3t_max_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3t_max_n_crs",zmin,zmax441 zmin=MINVAL(e3w_max_n_crs);zmax=MAXVAL(e3w_max_n_crs);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld e3w_max_n_crs",zmin,zmax442 414 zmin=MINVAL(sshb);zmax=MAXVAL(sshb);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshb",zmin,zmax 443 415 zmin=MINVAL(sshn);zmax=MAXVAL(sshn);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crsfld sshn",zmin,zmax -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r7210 r7215 223 223 CALL crs_dom_e3( e1v, e2v, zfse3v, p_sfc_2d_crs=e1v_crs , cd_type='V', p_mask=vmask, p_e3_crs=e3v_0_crs, p_e3_max_crs=e3v_max_0_crs) 224 224 225 DO jk = 1, jpk 226 DO ji = 1, jpi_crs 227 DO jj = 1, jpj_crs 228 IF( e3t_max_0_crs(ji,jj,jk) == 0._wp ) e3t_max_0_crs(ji,jj,jk) = e3t_1d(jk) 229 IF( e3w_max_0_crs(ji,jj,jk) == 0._wp ) e3w_max_0_crs(ji,jj,jk) = e3w_1d(jk) 230 IF( e3u_max_0_crs(ji,jj,jk) == 0._wp ) e3u_max_0_crs(ji,jj,jk) = e3t_1d(jk) 231 IF( e3v_max_0_crs(ji,jj,jk) == 0._wp ) e3v_max_0_crs(ji,jj,jk) = e3t_1d(jk) 232 ENDDO 233 ENDDO 234 ENDDO 225 WHERE(e3t_max_0_crs == 0._wp) e3t_max_0_crs=r_inf 226 WHERE(e3u_max_0_crs == 0._wp) e3u_max_0_crs=r_inf 227 WHERE(e3v_max_0_crs == 0._wp) e3v_max_0_crs=r_inf 228 WHERE(e3w_max_0_crs == 0._wp) e3w_max_0_crs=r_inf 235 229 236 230 #if defined key_vvl … … 287 281 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_0_crs, p_e3=zfse3t, psgn=1.0 ) 288 282 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_0_crs, p_e3=zfse3w, psgn=1.0 ) 289 290 DO jk = 1, jpk291 DO ji = 1, jpi_crs292 DO jj = 1, jpj_crs293 IF( gdept_0_crs(ji,jj,jk) .LE. 0._wp ) gdept_0_crs(ji,jj,jk) = gdept_1d(jk)294 IF( gdepw_0_crs(ji,jj,jk) .LE. 0._wp ) gdepw_0_crs(ji,jj,jk) = gdepw_1d(jk)295 ENDDO296 ENDDO297 ENDDO298 299 283 #if defined key_vvl 300 284 gdept_n_crs(:,:,:) = gdept_0_crs(:,:,:) -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r7210 r7215 35 35 USE zpshde_crs ! partial step: hor. derivative (zps_hde routine) 36 36 USE dom_oce , ONLY : ln_crs, ln_isfcav 37 USE crs , ONLY : jpi_crs,jpj_crs,wn_crs,ln_crs_top 37 USE crs , ONLY : jpi_crs,jpj_crs,wn_crs,ln_crs_top,sbc_trc_crs,sbc_trc_b_crs 38 38 USE ldfslp_crs 39 39 #if defined key_agrif
Note: See TracChangeset
for help on using the changeset viewer.