Changeset 3778
- Timestamp:
- 2013-02-08T11:40:58+01:00 (11 years ago)
- Location:
- branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM
- Files:
-
- 9 edited
-
CONFIG/ORCA2_LIM_CRS/EXP00/iodef.xml (modified) (5 diffs)
-
CONFIG/ORCA2_LIM_CRS/MY_SRC/iom.F90 (modified) (1 diff)
-
CONFIG/ORCA2_LIM_CRS/MY_SRC/lbclnk.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/CRS/crs.F90 (modified) (13 diffs)
-
NEMO/OPA_SRC/CRS/crs_dom.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/CRS/crs_iom.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/CRS/crsdiawri.F90 (modified) (17 diffs)
-
NEMO/OPA_SRC/CRS/crsdomwri.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/CRS/crsini.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS/EXP00/iodef.xml
r3622 r3778 291 291 <field id="soce_crs" description="salinity" unit="psu" axis_ref="deptht" /> 292 292 <field id="ssh_crs" description="sea surface height" unit="m" /> 293 <field id="ssh2_crs" description="sea surface height" unit="m" /> 293 294 <field id="sst_crs" description="sea surface temperature" unit="degC" /> 294 295 <field id="sss_crs" description="sea surface salinity" unit="psu" /> … … 311 312 <group id="gcrs_W" axis_ref="depthw" grid_ref="grid_W_crs"> 312 313 <field id="woce_crs" description="ocean vertical velocity" unit="m/s" /> 314 <field id="woce2_crs" description="ocean vertical velocity" unit="m/s" /> 313 315 <field id="wocet_crs" description="ocean vertical velocity times temperature" unit="degC.m/s" /> 314 316 <field id="woces_crs" description="ocean vertical velocity times salinity" unit="psu.m/s" /> … … 347 349 <field ref="soce_crs" name="vosaline" /> 348 350 <field ref="ssh_crs" name="sossheig" /> 351 <field ref="ssh2_crs" name="sossheig2" /> 349 352 <field ref="hdiv_crs" name="vohdiver" /> 350 353 <field ref="sst_crs" name="sosstsst" /> … … 431 434 <field ref="soce_crs" name="vosaline" /> 432 435 <field ref="ssh_crs" name="sossheig" /> 436 <field ref="ssh2_crs" name="sossheig2" /> 433 437 <field ref="sst_crs" name="sosstsst" /> 434 438 <field ref="sss_crs" name="sosaline" /> … … 474 478 <file id="5d_gcrs_W" name="auto" description="ocean U grid coarsened variables" > 475 479 <field ref="woce_crs" name="vovecrtz" /> 480 <field ref="woce2_crs" name="vovecrtz2" /> 476 481 <field ref="wocet_crs" name="vovewoct" /> 477 482 <field ref="woces_crs" name="vovewocs" /> -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS/MY_SRC/iom.F90
r3738 r3778 114 114 CALL set_grid( "grid_V", glamv, gphiv ) 115 115 CALL set_grid( "grid_W", glamt, gphit ) 116 116 !cc 117 IF(ln_crs) THEN 117 118 ! horizontal coarse grid definition 118 CALL setgrid_crs( "grid_T_crs", glamt_crs, gphit_crs ) 119 CALL setgrid_crs( "grid_U_crs", glamu_crs, gphiu_crs ) 120 CALL setgrid_crs( "grid_V_crs", glamv_crs, gphiv_crs ) 121 CALL setgrid_crs( "grid_W_crs", glamt_crs, gphit_crs ) 119 CALL setgrid_crs( "grid_T_crs", glamt_crs, gphit_crs ) 120 CALL setgrid_crs( "grid_U_crs", glamu_crs, gphiu_crs ) 121 CALL setgrid_crs( "grid_V_crs", glamv_crs, gphiv_crs ) 122 CALL setgrid_crs( "grid_W_crs", glamt_crs, gphit_crs ) 123 ENDIF 122 124 123 125 ! vertical grid definition -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS/MY_SRC/lbclnk.F90
r3622 r3778 161 161 END SELECT 162 162 ! ! North fold 163 pt3d( 1 ,jpj,:) = zland 164 pt3d(jpi,jpj,:) = zland 163 165 164 CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn ) 166 165 ! … … 249 248 pt2d(:, 1 ) = zland 250 249 END SELECT 251 ! ! North fold 252 pt2d( 1 ,1 ) = zland 253 pt2d( 1 ,jpj) = zland 254 pt2d(jpi,jpj) = zland 250 255 251 CALL lbc_nfd( pt2d(:,:), cd_type, psgn ) 256 252 ! -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r3735 r3778 43 43 PRIVATE 44 44 45 PUBLIC crsfun 45 PUBLIC crsfun, crs_e3_max, crs_surf 46 46 47 47 INTERFACE crsfun … … 282 282 p_cglam(jpi_crs,1) = p_cglam(2,1) 283 283 ! Fill upper-right corner i=1, j=jpj_crs 284 IF ( nperio == 4 ) THEN285 p_cgphi(1,jpj_crs) = p_cgphi(jpi_crsm1,jpj_crs-2)286 p_cglam(1,jpj_crs) = p_cglam(jpi_crsm1,jpj_crs-2)287 ELSEIF ( nperio == 6 ) THEN288 p_cgphi(1,jpj_crs) = p_cgphi(jpi_crs,jpj_crsm1)289 p_cglam(1,jpj_crs) = p_cglam(jpi_crs,jpj_crsm1)290 ENDIF284 !cc IF ( nperio == 4 ) THEN 285 !cc p_cgphi(1,jpj_crs) = p_cgphi(jpi_crsm1,jpj_crs-2) 286 !cc p_cglam(1,jpj_crs) = p_cglam(jpi_crsm1,jpj_crs-2) 287 !cc ELSEIF ( nperio == 6 ) THEN 288 !cc p_cgphi(1,jpj_crs) = p_cgphi(jpi_crs,jpj_crsm1) 289 !cc p_cglam(1,jpj_crs) = p_cglam(jpi_crs,jpj_crsm1) 290 !cc ENDIF 291 291 292 292 WRITE(numout,*) 'crsfun_coordinates. done' … … 398 398 399 399 zcfield2d_1(:,:) = 0.0 ; zcfield2d_2(:,:) = 0.0 400 DO ji = 2, jpi_crsm1 400 ! DO ji = 2, jpi_crsm1 401 DO ji = 1, jpi_crs 401 402 ijie = mie_crs(ji) 402 403 ijis = mis_crs(ji) 403 404 404 DO jj = 1, jpj_crsm1 405 ! DO jj = 1, jpj_crsm1 406 DO jj = 1, jpj_crs 405 407 ijje = mje_crs(jj) 406 408 ijjs = mjs_crs(jj) … … 430 432 431 433 ELSE 432 433 ! Calculate e1 scale factor or if present ze3, unmasked surface area 434 DO jii = ijis, ijie 435 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii,ijje) * ze3(jii,ijje,jk) ) 436 ENDDO 437 438 ! Calculate e2 scale factor 439 DO jjj = ijjs, ijje 440 zcfield2d_2(ji,jj) = zcfield2d_2(ji,jj) + ( ze2(ijie,jjj) * ze3(ijie,jjj,jk) ) 441 ENDDO 442 434 SELECT CASE ( cd_type ) 435 436 CASE ( 'T' ) 437 IF ( nn_factx == 3 ) THEN 438 ! Calculate e1 scale factor or if present ze3, unmasked surface area 439 IF (jj == 1) THEN 440 DO jii = ijis, ijie 441 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii,ijje) * ze3(jii,ijje-1,jk) ) 442 ENDDO 443 ELSE 444 DO jii = ijis, ijie 445 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii,ijje-1) * ze3(jii,ijje-1,jk) ) 446 ENDDO 447 ENDIF 448 449 ! Calculate e2 scale factor 450 DO jjj = ijjs, ijje 451 zcfield2d_2(ji,jj) = zcfield2d_2(ji,jj) + ( ze2(ijie-1,jjj) * ze3(ijie-1,jjj,jk) ) 452 ENDDO 453 ENDIF 454 455 CASE ( 'U' ) 456 IF ( nn_factx == 3 ) THEN 457 ! Calculate e1 scale factor or if present ze3, unmasked surface area 458 IF (jj == 1) THEN 459 DO jii = ijis, ijie 460 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii+1,ijje) * ze3(jii+1,ijje-1,jk) ) 461 ENDDO 462 ELSE 463 DO jii = ijis, ijie 464 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii+1,ijje-1) * ze3(jii+1,ijje-1,jk) ) 465 ENDDO 466 ENDIF 467 ! Calculate e2 scale factor 468 DO jjj = ijjs, ijje 469 zcfield2d_2(ji,jj) = zcfield2d_2(ji,jj) + ( ze2(ijie,jjj) * ze3(ijie,jjj,jk) ) 470 ENDDO 471 ENDIF 472 473 CASE ( 'V' ) 474 IF ( nn_factx == 3 ) THEN 475 ! Calculate e1 scale factor or if present ze3, unmasked surface area 476 DO jii = ijis, ijie 477 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii,ijje) * ze3(jii,ijje,jk) ) 478 ENDDO 479 480 ! Calculate e2 scale factor 481 DO jjj = ijjs, ijje 482 zcfield2d_2(ji,jj) = zcfield2d_2(ji,jj) + ( ze2(ijie-1,jjj+1) * ze3(ijie-1,jjj+1,jk) ) 483 ENDDO 484 ENDIF 485 486 CASE ( 'F' ) 487 IF ( nn_factx == 3 ) THEN 488 ! Calculate e1 scale factor or if present ze3, unmasked surface area 489 DO jii = ijis, ijie 490 zcfield2d_1(ji,jj) = zcfield2d_1(ji,jj) + ( ze1(jii+1,ijje) * ze3(jii+1,ijje,jk) ) 491 ENDDO 492 493 ! Calculate e2 scale factor 494 DO jjj = ijjs, ijje 495 zcfield2d_2(ji,jj) = zcfield2d_2(ji,jj) + ( ze2(ijie,jjj+1) * ze3(ijie,jjj+1,jk) ) 496 ENDDO 497 ENDIF 498 END SELECT 499 500 501 443 502 IF ( PRESENT(p_cfield3d_1) ) THEN 444 503 … … 468 527 469 528 ENDIF 529 530 IF ( cd_op == 'POS' ) THEN !cc 531 532 IF ( nn_factx == 3 .AND. nn_facty == 3) THEN 533 534 SELECT CASE ( cd_type ) 535 536 CASE ( 'T' ) 537 538 IF ((jj == 1) .AND. (ji == 1)) THEN 539 ! Calculate e1 scale factor or if present ze3, unmasked surface area 540 zcfield2d_1(ji,jj) = ( ze1(ijie,ijje ) * ze3(ijie,ijje,jk) ) * nn_factx 541 542 ! Calculate e2 scale factor 543 zcfield2d_2(ji,jj) = ( ze2(ijie,ijje ) * ze3(ijie,ijje,jk) ) * nn_facty 544 ELSEIF (jj == 1) THEN 545 ! Calculate e1 scale factor or if present ze3, unmasked surface area 546 zcfield2d_1(ji,jj) = ( ze1(ijie-1,ijje ) * ze3(ijie-1,ijje,jk) ) * nn_factx 547 548 ! Calculate e2 scale factor 549 zcfield2d_2(ji,jj) = ( ze2(ijie-1,ijje ) * ze3(ijie-1,ijje,jk) ) * nn_facty 550 ELSEIF (ji == 1) THEN 551 ! Calculate e1 scale factor or if present ze3, unmasked surface area 552 zcfield2d_1(ji,jj) = ( ze1(ijie,ijje-1) * ze3(ijie,ijje-1,jk) ) * nn_factx 553 554 ! Calculate e2 scale factor 555 zcfield2d_2(ji,jj) = ( ze2(ijie,ijje-1) * ze3(ijie,ijje-1,jk) ) * nn_facty 556 ELSE 557 ! Calculate e1 scale factor or if present ze3, unmasked surface area 558 zcfield2d_1(ji,jj) = ( ze1(ijie-1,ijje-1) * ze3(ijie-1,ijje-1,jk) ) * nn_factx 559 560 ! Calculate e2 scale factor 561 zcfield2d_2(ji,jj) = ( ze2(ijie-1,ijje-1) * ze3(ijie-1,ijje-1,jk) ) * nn_facty 562 ENDIF 563 564 CASE ( 'U' ) 565 IF (jj == 1) THEN 566 ! Calculate e1 scale factor or if present ze3, unmasked surface area 567 zcfield2d_1(ji,jj) = ( ze1(ijie ,ijje ) * ze3(ijie ,ijje,jk) ) * nn_factx 568 569 ! Calculate e2 scale factor 570 zcfield2d_2(ji,jj) = ( ze2(ijie ,ijje ) * ze3(ijie ,ijje,jk) ) * nn_facty 571 ELSE 572 ! Calculate e1 scale factor or if present ze3, unmasked surface area 573 zcfield2d_1(ji,jj) = ( ze1(ijie ,ijje-1) * ze3(ijie ,ijje-1,jk) ) * nn_factx 574 575 ! Calculate e2 scale factor 576 zcfield2d_2(ji,jj) = ( ze2(ijie ,ijje-1) * ze3(ijie ,ijje-1,jk) ) * nn_facty 577 ENDIF 578 579 CASE ( 'V' ) 580 IF (ji == 1) THEN 581 ! Calculate e1 scale factor or if present ze3, unmasked surface area 582 zcfield2d_1(ji,jj) = ( ze1(ijie,ijje ) * ze3(ijie,ijje ,jk) ) * nn_factx 583 584 ! Calculate e2 scale factor 585 zcfield2d_2(ji,jj) = ( ze2(ijie,ijje ) * ze3(ijie,ijje ,jk) ) * nn_facty 586 ELSE 587 ! Calculate e1 scale factor or if present ze3, unmasked surface area 588 zcfield2d_1(ji,jj) = ( ze1(ijie-1,ijje ) * ze3(ijie-1,ijje ,jk) ) * nn_factx 589 590 ! Calculate e2 scale factor 591 zcfield2d_2(ji,jj) = ( ze2(ijie-1,ijje ) * ze3(ijie-1,ijje ,jk) ) * nn_facty 592 ENDIF 593 594 CASE ( 'F' ) 595 ! Calculate e1 scale factor or if present ze3, unmasked surface area 596 zcfield2d_1(ji,jj) = ( ze1(ijie ,ijje ) * ze3(ijie ,ijje ,jk) ) * nn_factx 597 598 ! Calculate e2 scale factor 599 zcfield2d_2(ji,jj) = ( ze2(ijie ,ijje ) * ze3(ijie ,ijje ,jk) ) * nn_facty 600 601 END SELECT 602 ENDIF 603 ENDIF !cc 604 470 605 471 606 IF ( cd_op == 'WGT' ) THEN … … 540 675 541 676 ! Take care of the 2D arrays 542 IF ( cd_op == 'SUM' ) THEN677 IF ( cd_op == 'SUM' .OR. cd_op == 'POS') THEN 543 678 IF ( PRESENT(p_cfield2d_1) ) THEN 544 679 p_cfield2d_1(:,:) = zcfield2d_1(:,:) … … 546 681 547 682 ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 548 p_cfield2d_1(:,1) = zcfield2d_1(:,1) 683 p_cfield2d_1(:,1) = zcfield2d_1(:,1) !cc 549 684 ! Fill i=1, i=jpi at j=1 550 685 p_cfield2d_1(1,1) = p_cfield2d_1(jpi_crsm1,1) 551 686 p_cfield2d_1(jpi_crs,1) = p_cfield2d_1(2,1) 552 553 ! Fill upper-right corner i=1, j=jpj_crs 554 IF ( nperio == 4 ) THEN 555 p_cfield2d_1(1,jpj_crs) = p_cfield2d_1(jpi_crsm1,jpj_crs-2) 556 ELSEIF ( nperio == 6 ) THEN 557 p_cfield2d_1(1,jpj_crs) = p_cfield2d_1(jpi_crs,jpj_crsm1) 558 ENDIF 687 688 !cc p_cfield2d_1(1,jpj_crs-1) = p_cfield2d_1(3,jpj_crs-1) 689 690 ! Fill upper-right corner i=1, j=jpj_crs 691 !cc IF ( nperio == 4 ) THEN on écrase les valeurs limites calculées dans crs_lbc_lnk 692 !cc p_cfield2d_1(1,jpj_crs) = p_cfield2d_1(jpi_crsm1,jpj_crs-2) 693 !cc ELSEIF ( nperio == 6 ) THEN 694 !cc p_cfield2d_1(1,jpj_crs) = p_cfield2d_1(jpi_crs,jpj_crsm1) 695 !cc ENDIF 559 696 560 697 ENDIF … … 562 699 p_cfield2d_2(:,:) = zcfield2d_2(:,:) 563 700 CALL crs_lbc_lnk( cd_type,1.0,pt2d=p_cfield2d_2 ) 564 701 565 702 ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd 566 703 p_cfield2d_2(:,1) = zcfield2d_2(:,1) … … 569 706 p_cfield2d_2(1,1) = p_cfield2d_2(jpi_crsm1,1) 570 707 p_cfield2d_2(jpi_crs,1) = p_cfield2d_2(2,1) 571 708 IF ( cd_op == 'SUM') THEN 709 DO jii = 1 , jpiglo_crs 710 p_cfield2d_2(jii,1) = p_cfield2d_2(jii,1) * 3 711 ENDDO 712 ENDIF 572 713 ! Fill upper-right corner i=1, j=jpj_crs 573 IF ( nperio == 4 ) THEN574 p_cfield2d_2(1,jpj_crs) = p_cfield2d_2(jpi_crsm1,jpj_crs-2)575 ELSEIF ( nperio == 6 ) THEN576 p_cfield2d_2(1,jpj_crs) = p_cfield2d_2(jpi_crs,jpj_crsm1)577 714 !cc IF ( nperio == 4 ) THEN 715 !cc p_cfield2d_2(1,jpj_crs) = p_cfield2d_2(jpi_crsm1,jpj_crs-2) 716 !cc ELSEIF ( nperio == 6 ) THEN 717 !cc p_cfield2d_2(1,jpj_crs) = p_cfield2d_2(jpi_crs,jpj_crsm1) 718 !cc ENDIF 578 719 ENDIF 579 720 … … 588 729 589 730 ! Take care now of 3d arrays 590 IF ( cd_op == 'SUM' .OR. cd_op == 'VOL' ) THEN731 IF ( cd_op == 'SUM' .OR. cd_op == 'VOL' .OR. cd_op == 'POS' ) THEN 591 732 CALL crs_lbc_lnk( cd_type,1.0,pt3d1=zcfield3d_1 ) 592 733 IF ( PRESENT(p_cfield3d_1) ) p_cfield3d_1(:,:,:) = zcfield3d_1(:,:,:) … … 607 748 608 749 ELSE 609 IF ( cd_op == 'SUM' ) THEN750 IF ( cd_op == 'SUM' .OR. cd_op == 'POS' ) THEN 610 751 IF ( PRESENT(p_cfield2d_1) ) THEN 611 752 p_cfield2d_1(:,:) = zcfield2d_1(:,:) … … 918 1059 ijis = mis_crs(ji) 919 1060 920 DO jj = 2, jpj_crsm1 1061 ! DO jj = 2, jpj_crsm1 1062 DO jj = 1, jpj_crsm1 921 1063 ijje = mje_crs(jj) 922 1064 ijjs = mjs_crs(jj) … … 1027 1169 END SUBROUTINE crsfun_TW 1028 1170 1171 SUBROUTINE crs_e3_max( p_e3, cd_type, p_mask, p_e3_crs) 1172 !!---------------------------------------------------------------- 1173 !! *** SUBROUTINE crsfun_TW *** 1174 !! ** Purpose : Five applications. 1175 !! 1) Maximum surface quantity 1176 !! - Vertical scale factors (fse3t or fse3w) 1177 !! max thickness of the parent grid for coarse grid scale factors. 1178 !! - or diffusion test 1179 !! 2) Area-weighted mean quantity: w, or other 3D or 2D quantity 1180 !! 3) Volume-weighted mean quantity: tracer 1181 !! 4) Minimum surface quantity (diffusion test) 1182 !! 5) Area- or Volume- weighted sum. 1183 !! ** Method : 1) - cd_op = 'MAX'. Determines the max vertical thickness of grid boxes 1184 !! including partial steps for at the bottom 1185 !! for the coarsened grid, where within the subset of 1186 !! the parent grid cells the maximum thickness is taken. 1187 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1188 !! Where, normally p_pfield3d_1 is e3t. 1189 !! - cd_op = 'MAX'. May also be used for say, determining the maximum value of Kz, 1190 !! thus p_pfield3d_1 is set to the 3D field, Kz. 1191 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1192 !! 2) - cd_op = 'ARE'. Calculate the area-weighted average (surface e1t*e2t) 1193 !! of vertical velocity, w. 1194 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1195 !! - cd_op = 'ARE'. Calculate area-weighted average of a 2D quantity (e.g. emp) 1196 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield2d 1197 !! 3) - cd_op = 'VOL'. Calculate the ocean volume (e1e2t*[fse3t|fse3w]) 1198 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1199 !! - cd_op = 'VOL'. Calculate volume-weighted average (volume e1t*e2t*fse3t) of a quantity. 1200 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1, p_pfield3d_2 1201 !! 4) - cd_op = 'MIN'. Calculate the minimum value on surface e1t*e2t for 3D variables 1202 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1203 !! 5) - cd_op = 'SUM'. Calculate a dimesionally-weighted sum. This could be area-weighted 1204 !! or volume-weighted sum. 1205 !! ** Inputs : p_e1e2t = parent grid top face surface area, e1t*e2t 1206 !! cd_type = grid type T, W (U, V, F) 1207 !! cd_op = MAX, ARE, VOL, MIN, SUM 1208 !! p_cmask = coarse grid mask 1209 !! p_ptmask = parent grid tmask 1210 !! psgn = (Optional) sign for lbc_lnk 1211 !! p_pfield2d = (Optional) 2D field on parent grid 1212 !! p_pfield3d_1 = (Optional) parent grid fse3t or fse3w 1213 !! p_pfield3d_2 = (Optional) 3D field on parent grid 1214 !! ** Outputs : p_cfield2d = (Optional) 2D field on coarse grid 1215 !! p_cfield3d = (Optional) 3D field on coarse grid 1216 !! 1217 !! 1218 !! History. 30 May. Editing. To decide later: Keep all functionality or separate out the mean function. 1219 !! 7 Jun TODO. Need to fix up the parent grid mask to optional like crsfun_UV... 1220 !!---------------------------------------------------------------- 1221 !! 1222 !! Arguments 1223 CHARACTER(len=1), INTENT(in) :: cd_type ! grid type T, W ( U, V, F) 1224 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T mask 1225 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(in) :: p_e3 ! 3D tracer T or W on parent grid 1226 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), OPTIONAL, INTENT(out):: p_e3_crs ! Coarse grid box east or north face quantity 1227 1228 !! Local variables 1229 INTEGER :: ji, jj, jk ! dummy loop indices 1230 INTEGER :: ijie,ijis,ijje,ijjs,ijpk,jii,jjj 1231 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3, ze3_crs, zpmask 1232 !!---------------------------------------------------------------- 1233 ! Initialize 1234 1235 ALLOCATE( ze3(jpi,jpj,jpk), zpmask(jpi,jpj,jpk) ) 1236 ALLOCATE( ze3_crs(jpi_crs,jpj_crs,jpk) ) 1237 1238 ! Arrays, scalars initialization 1239 ze3(:,:,:) = p_e3(:,:,:) 1240 ze3_crs(:,:,:) = 0.0 1241 zpmask(:,:,:) = p_mask(:,:,:) 1242 ijpk = jpk 1243 1244 SELECT CASE ( cd_type ) 1245 1246 CASE ('T') 1247 1248 DO jk = 1 , ijpk 1249 1250 DO ji = 1, jpi_crs ! ji = 1 et jpi_crs definit par cyclique est-ouest et pivot T 1251 ijie = mie_crs(ji) 1252 ijis = mis_crs(ji) 1253 1254 DO jj = 1, jpj_crs ! jj = jpj_crs definit par pivot T 1255 ijje = mje_crs(jj) 1256 ijjs = mjs_crs(jj) 1257 1258 DO jii = ijis, ijie 1259 DO jjj = ijjs, ijje 1260 ze3_crs(ji,jj,jk) = max( ze3_crs(ji,jj,jk), ze3(jii,jjj,jk) * zpmask(jii,jjj,jk) ) 1261 ENDDO 1262 ENDDO 1263 ENDDO 1264 ENDDO 1265 ENDDO 1266 1267 CASE ('W') 1268 1269 DO jk = 2 , ijpk 1270 1271 DO ji = 1, jpi_crs ! ji = 1 et jpi_crs definit par cyclique est-ouest et pivot T 1272 ijie = mie_crs(ji) 1273 ijis = mis_crs(ji) 1274 1275 DO jj = 1, jpj_crs ! jj = jpj_crs definit par pivot T 1276 ijje = mje_crs(jj) 1277 ijjs = mjs_crs(jj) 1278 1279 DO jii = ijis, ijie 1280 DO jjj = ijjs, ijje 1281 ze3_crs(ji,jj,jk) = max( ze3_crs(ji,jj,jk), ze3(jii,jjj,jk) * zpmask(jii,jjj,jk-1) ) 1282 ENDDO 1283 ENDDO 1284 ENDDO 1285 ENDDO 1286 ENDDO 1287 1288 jk = 1 ! cas particulier car zpmask(jii,jjj,0) n'existe pas 1289 1290 DO ji = 1, jpi_crs 1291 ijie = mie_crs(ji) 1292 ijis = mis_crs(ji) 1293 1294 DO jj = 1, jpj_crs 1295 ijje = mje_crs(jj) 1296 ijjs = mjs_crs(jj) 1297 1298 DO jii = ijis, ijie 1299 DO jjj = ijjs, ijje 1300 ze3_crs(ji,jj,jk) = max( ze3_crs(ji,jj,jk), ze3(jii,jjj,jk) * zpmask(jii,jjj,jk) ) 1301 ENDDO 1302 ENDDO 1303 ENDDO 1304 ENDDO 1305 1306 END SELECT 1307 1308 p_e3_crs(:,:,:) = ze3_crs(:,:,:) 1309 1310 CALL crs_lbc_lnk( cd_type, 1.0, pt3d1=p_e3_crs ) 1311 1312 ! lbcnlk met la ligne jpj = 1 a 0 donc il faut la remettre en ne pas oubliant le cyclique est-ouest 1313 1314 p_e3_crs( : ,1,:) = ze3_crs( : ,1,:) 1315 p_e3_crs( 1 ,1,:) = ze3_crs(jpi_crsm1,1,:) 1316 p_e3_crs(jpi_crs,1,:) = ze3_crs( 2 ,1,:) 1317 1318 1319 DEALLOCATE( ze3 , zpmask ) 1320 DEALLOCATE( ze3_crs ) 1321 1322 1323 END SUBROUTINE crs_e3_max 1324 1325 1326 SUBROUTINE crs_surf(p_e1, p_e2 ,p_e3, cd_type, p_mask, surf_crs, surf_msk_crs) 1327 !!---------------------------------------------------------------- 1328 !! *** SUBROUTINE crsfun_TW *** 1329 !! ** Purpose : Five applications. 1330 !! 1) Maximum surface quantity 1331 !! - Vertical scale factors (fse3t or fse3w) 1332 !! max thickness of the parent grid for coarse grid scale factors. 1333 !! - or diffusion test 1334 !! 2) Area-weighted mean quantity: w, or other 3D or 2D quantity 1335 !! 3) Volume-weighted mean quantity: tracer 1336 !! 4) Minimum surface quantity (diffusion test) 1337 !! 5) Area- or Volume- weighted sum. 1338 !! ** Method : 1) - cd_op = 'MAX'. Determines the max vertical thickness of grid boxes 1339 !! including partial steps for at the bottom 1340 !! for the coarsened grid, where within the subset of 1341 !! the parent grid cells the maximum thickness is taken. 1342 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1343 !! Where, normally p_pfield3d_1 is e3t. 1344 !! - cd_op = 'MAX'. May also be used for say, determining the maximum value of Kz, 1345 !! thus p_pfield3d_1 is set to the 3D field, Kz. 1346 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1347 !! 2) - cd_op = 'ARE'. Calculate the area-weighted average (surface e1t*e2t) 1348 !! of vertical velocity, w. 1349 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1350 !! - cd_op = 'ARE'. Calculate area-weighted average of a 2D quantity (e.g. emp) 1351 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield2d 1352 !! 3) - cd_op = 'VOL'. Calculate the ocean volume (e1e2t*[fse3t|fse3w]) 1353 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1354 !! - cd_op = 'VOL'. Calculate volume-weighted average (volume e1t*e2t*fse3t) of a quantity. 1355 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1, p_pfield3d_2 1356 !! 4) - cd_op = 'MIN'. Calculate the minimum value on surface e1t*e2t for 3D variables 1357 !! Valid arguments: p_e1e2t, cd_type, cd_op, p_cmask, p_pfield3d_1 1358 !! 5) - cd_op = 'SUM'. Calculate a dimesionally-weighted sum. This could be area-weighted 1359 !! or volume-weighted sum. 1360 !! ** Inputs : p_e1e2t = parent grid top face surface area, e1t*e2t 1361 !! cd_type = grid type T, W (U, V, F) 1362 !! cd_op = MAX, ARE, VOL, MIN, SUM 1363 !! p_cmask = coarse grid mask 1364 !! p_ptmask = parent grid tmask 1365 !! psgn = (Optional) sign for lbc_lnk 1366 !! p_pfield2d = (Optional) 2D field on parent grid 1367 !! p_pfield3d_1 = (Optional) parent grid fse3t or fse3w 1368 !! p_pfield3d_2 = (Optional) 3D field on parent grid 1369 !! ** Outputs : p_cfield2d = (Optional) 2D field on coarse grid 1370 !! p_cfield3d = (Optional) 3D field on coarse grid 1371 !! 1372 !! 1373 !! History. 30 May. Editing. To decide later: Keep all functionality or separate out the mean function. 1374 !! 7 Jun TODO. Need to fix up the parent grid mask to optional like crsfun_UV... 1375 !!---------------------------------------------------------------- 1376 !! 1377 !! Arguments 1378 CHARACTER(len=1), INTENT(in) :: cd_type ! grid type T, W ( U, V, F) 1379 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T mask 1380 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(in) :: p_e1, p_e2, p_e3 ! 3D tracer T or W on parent grid 1381 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), OPTIONAL, INTENT(out):: surf_crs, surf_msk_crs ! Coarse grid box east or north face quantity 1382 1383 !! Local variables 1384 INTEGER :: ji, jj, jk ! dummy loop indices 1385 INTEGER :: ijie,ijis,ijje,ijjs,ijpk,jii,jjj 1386 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze1, ze2, ze3, zsurf_crs, zsurf_msk_crs, zpmask 1387 !!---------------------------------------------------------------- 1388 ! Initialize 1389 1390 ALLOCATE( ze1(jpi,jpj,jpk), ze2(jpi,jpj,jpk), ze3(jpi,jpj,jpk), zpmask(jpi,jpj,jpk) ) 1391 ALLOCATE( zsurf_crs(jpi_crs,jpj_crs,jpk), zsurf_msk_crs(jpi_crs,jpj_crs,jpk) ) 1392 1393 ! Arrays, scalars initialization 1394 ze1(:,:,:) = p_e1(:,:,:) 1395 ze2(:,:,:) = p_e2(:,:,:) 1396 ze3(:,:,:) = p_e3(:,:,:) 1397 zsurf_crs(:,:,:) = 0.0 1398 zsurf_msk_crs(:,:,:) = 0.0 1399 zpmask(:,:,:) = p_mask(:,:,:) 1400 ijpk = jpk 1401 1402 SELECT CASE ( cd_type ) 1403 1404 CASE ('W') 1405 1406 DO jk = 2 , ijpk 1407 1408 DO ji = 1, jpi_crs ! ji = 1 et jpi_crs definit par cyclique est-ouest et pivot T 1409 ijie = mie_crs(ji) 1410 ijis = mis_crs(ji) 1411 jj = 1 1412 ijje = mje_crs(jj) 1413 ijjs = mjs_crs(jj) 1414 1415 DO jii = ijis, ijie 1416 DO jjj = ijjs, ijje 1417 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze1(ji,jj,jk) * ze2(jii,jjj,jk) 1418 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze1(ji,jj,jk) * ze2(jii,jjj,jk) ) * zpmask(jii,jjj,jk-1) 1419 ENDDO 1420 ENDDO 1421 1422 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) * 3 1423 1424 DO jj = 2, jpj_crs ! jj = jpj_crs definit par pivot T 1425 ijje = mje_crs(jj) 1426 ijjs = mjs_crs(jj) 1427 1428 DO jii = ijis, ijie 1429 DO jjj = ijjs, ijje 1430 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze1(ji,jj,jk) * ze2(jii,jjj,jk) 1431 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze1(ji,jj,jk) * ze2(jii,jjj,jk) ) * zpmask(jii,jjj,jk-1) 1432 ENDDO 1433 ENDDO 1434 ENDDO 1435 ENDDO 1436 ENDDO 1437 1438 jk = 1 !cas particulier ou on est en surface 1439 1440 DO ji = 1, jpi_crs ! ji = 1 et jpi_crs definit par cyclique est-ouest et pivot T 1441 ijie = mie_crs(ji) 1442 ijis = mis_crs(ji) 1443 jj = 1 1444 ijje = mje_crs(jj) 1445 ijjs = mjs_crs(jj) 1446 1447 DO jii = ijis, ijie 1448 DO jjj = ijjs, ijje 1449 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze1(ji,jj,jk) * ze2(jii,jjj,jk) 1450 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze1(ji,jj,jk) * ze2(jii,jjj,jk) ) * zpmask(jii,jjj,jk) 1451 ENDDO 1452 ENDDO 1453 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) * 3 1454 DO jj = 2, jpj_crs ! jj = jpj_crs definit par pivot T 1455 ijje = mje_crs(jj) 1456 ijjs = mjs_crs(jj) 1457 DO jii = ijis, ijie 1458 DO jjj = ijjs, ijje 1459 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze1(ji,jj,jk) * ze2(jii,jjj,jk) 1460 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze1(ji,jj,jk) * ze2(jii,jjj,jk) ) * zpmask(jii,jjj,jk) 1461 ENDDO 1462 ENDDO 1463 ENDDO 1464 ENDDO 1465 1466 CASE ('U') 1467 1468 DO jk = 1 , ijpk 1469 1470 DO ji = 1, jpi_crs ! ji = 1 et jpi_crs definit par cyclique est-ouest et pivot T 1471 ijie = mie_crs(ji) 1472 ijis = mis_crs(ji) 1473 jj = 1 1474 ijje = mje_crs(jj) 1475 ijjs = mjs_crs(jj) 1476 1477 DO jii = ijis, ijie 1478 DO jjj = ijjs, ijje 1479 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze3(ji,jj,jk) * ze2(jii,jjj,jk) 1480 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze3(ji,jj,jk) * ze2(jii,jjj,jk) ) * zpmask(jii,jjj,jk) 1481 ENDDO 1482 ENDDO 1483 1484 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) * 3 1485 1486 DO jj = 2, jpj_crs ! jj = jpj_crs definit par pivot T 1487 ijje = mje_crs(jj) 1488 ijjs = mjs_crs(jj) 1489 1490 DO jii = ijis, ijie 1491 DO jjj = ijjs, ijje 1492 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze3(ji,jj,jk) * ze2(jii,jjj,jk) 1493 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze3(ji,jj,jk) * ze2(jii,jjj,jk) ) * zpmask(jii,jjj,jk) 1494 ENDDO 1495 ENDDO 1496 ENDDO 1497 ENDDO 1498 ENDDO 1499 1500 CASE ('V') 1501 1502 DO jk = 1 , ijpk 1503 1504 DO ji = 1, jpi_crs ! ji = 1 et jpi_crs definit par cyclique est-ouest et pivot T 1505 ijie = mie_crs(ji) 1506 ijis = mis_crs(ji) 1507 1508 DO jj = 1, jpj_crs ! jj = jpj_crs definit par pivot T 1509 ijje = mje_crs(jj) 1510 ijjs = mjs_crs(jj) 1511 1512 DO jii = ijis, ijie 1513 DO jjj = ijjs, ijje 1514 zsurf_crs(ji,jj,jk) = zsurf_crs(ji,jj,jk) + ze3(ji,jj,jk) * ze1(jii,jjj,jk) 1515 zsurf_msk_crs(ji,jj,jk) = zsurf_msk_crs(ji,jj,jk) + ( ze3(ji,jj,jk) * ze1(jii,jjj,jk) ) * zpmask(jii,jjj,jk) 1516 ENDDO 1517 ENDDO 1518 ENDDO 1519 ENDDO 1520 ENDDO 1521 END SELECT 1522 1523 surf_crs(:,:,:) = zsurf_crs(:,:,:) 1524 CALL crs_lbc_lnk( cd_type, 1.0, pt3d1=surf_crs ) 1525 ! lbcnlk met la ligne jpj = 1 a 0 donc il faut la remettre en ne pas oubliant le cyclique est-ouest 1526 ! a faire un case pour cyclique est-ouest ou non. 1527 surf_crs( : ,1,:) = zsurf_crs( : ,1,:) 1528 surf_crs( 1 ,1,:) = zsurf_crs(jpi_crsm1,1,:) 1529 surf_crs(jpi_crs,1,:) = zsurf_crs( 2 ,1,:) 1530 1531 surf_msk_crs(:,:,:) = zsurf_msk_crs(:,:,:) 1532 CALL crs_lbc_lnk( cd_type, 1.0, pt3d1=surf_msk_crs ) 1533 ! lbcnlk met la ligne jpj = 1 a 0 donc il faut la remettre en ne pas oubliant le cyclique est-ouest 1534 surf_msk_crs( : ,1,:) = zsurf_msk_crs( : ,1,:) 1535 surf_msk_crs( 1 ,1,:) = zsurf_msk_crs(jpi_crsm1,1,:) 1536 surf_msk_crs(jpi_crs,1,:) = zsurf_msk_crs( 2 ,1,:) 1537 1538 DEALLOCATE( ze3 , ze2, ze1, zpmask ) 1539 DEALLOCATE( zsurf_msk_crs, zsurf_crs ) 1540 1541 1542 END SUBROUTINE crs_surf 1543 1029 1544 1030 1545 END MODULE crs -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs_dom.F90
r3738 r3778 13 13 PUBLIC 14 14 15 PUBLIC crs_dom_alloc ! Called from crsini.F90 15 16 PUBLIC crs_dom_alloc ! Called from crsini.F90 16 17 PUBLIC dom_grid_glo 17 18 PUBLIC dom_grid_crs … … 30 31 INTEGER :: npolj_full, npolj_crs !: north fold mark 31 32 INTEGER :: jpiglo_full, jpjglo_full !: jpiglo / jpjglo 33 INTEGER :: npiglo, npjglo !: jpjglo 32 34 INTEGER :: nlci_full, nlcj_full !: i-, j-dimension of local or sub domain on parent grid 33 35 INTEGER :: nldi_full, nldj_full !: starting indices of internal sub-domain on parent grid … … 59 61 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_crs, fse3u_crs, fse3v_crs, fse3f_crs, fse3w_crs 60 62 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_n_crs, fse3t_b_crs, fse3t_a_crs 61 63 64 ! Surface 65 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk, e1e2w, e2e3u, e1e3v 62 66 ! vertical scale factors 63 67 ! Coordinates … … 70 74 ! Weights 71 75 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w 72 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w 76 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs 73 77 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt 74 78 … … 192 196 & e3f_crs(jpi_crs,jpj_crs,jpk) , fse3f_crs(jpi_crs,jpj_crs,jpk) , & 193 197 & fse3t_b_crs(jpi_crs,jpj_crs,jpk), fse3t_n_crs(jpi_crs,jpj_crs,jpk),& 194 & fse3t_a_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6)) 198 & fse3t_a_crs(jpi_crs,jpj_crs,jpk), e1e2w_msk(jpi_crs,jpj_crs,jpk) , & 199 & e2e3u_msk(jpi_crs,jpj_crs,jpk) , e1e3v_msk(jpi_crs,jpj_crs,jpk) , & 200 & e1e2w(jpi_crs,jpj_crs,jpk) , e2e3u(jpi_crs,jpj_crs,jpk) , & 201 & e1e3v(jpi_crs,jpj_crs,jpk) , STAT=ierr(6)) 195 202 196 203 197 204 ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk) , facsurfu(jpi_crs,jpj_crs,jpk) , & 198 205 & facvol_t(jpi_crs,jpj_crs,jpk) , facvol_w(jpi_crs,jpj_crs,jpk) , & 199 & ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk) , STAT=ierr(7)) 206 & ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), & 207 & bt_crs(jpi_crs,jpj_crs,jpk) , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7)) 200 208 201 209 -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs_iom.F90
r3738 r3778 179 179 ELSEIF( PRESENT(pv_r3d) ) THEN ; CALL iom_put( cdvar, pv_r3d ) 180 180 ENDIF 181 182 181 CALL dom_grid_glo ! Return to parent grid domain 183 182 -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdiawri.F90
r3738 r3778 103 103 REAL(wp), POINTER, DIMENSION(:,:) :: ze1e2u ! 2D workspace 104 104 REAL(wp), POINTER, DIMENSION(:,:) :: ze1e2v ! 2D workspace 105 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dcrs ! 3D workspace for coarse grid106 REAL(wp), POINTER, DIMENSION(:,:) :: z2dcrs ! 2D workspace for coarse grid105 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dcrs, zw ! 3D workspace for coarse grid !cc 106 REAL(wp), POINTER, DIMENSION(:,:) :: z2dcrs, ssh_crs2 ! 2D workspace for coarse grid 107 107 INTEGER :: ialloc, iiki, iikn 108 108 INTEGER, SAVE :: itsct 109 109 REAL(wp) :: zdtj, zrtsct 110 !!cc1 111 REAL(wp) :: z2dcrsu, z2dcrsv 112 !!cc1 110 113 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: ztsnm 111 114 … … 125 128 REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0, zraur 126 129 REAL(wp) :: zij, zip1j, zijp1 127 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dcrsu, z2dcrsv, z2dcrsf 130 !!cc1 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dcrsu, z2dcrsv, z2dcrsf, zhdivbt 131 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dcrsf, zhdivbt 128 132 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsshub, zsshua, zsshvb, zsshva ! temp work arrays for instantaneous fields 129 133 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zhdiv, zvolt_wgt, zrhd, zrhop, zavt 130 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zhdivbt131 134 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zee_t, zee_f, zee_u, zee_v 132 135 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zmut, zmuf … … 150 153 CALL wrk_alloc( jpi , jpj , jpk , zfse3u, zfse3v ) 151 154 CALL wrk_alloc( jpi , jpj , jpk , zfse3t, zfse3w ) 152 CALL wrk_alloc( jpi_crs , jpj_crs , jpk , z3dcrs ) 153 CALL wrk_alloc( jpi_crs , jpj_crs , z2dcrs ) 155 CALL wrk_alloc( jpi_crs , jpj_crs , jpk , z3dcrs, zw ) !cc 156 CALL wrk_alloc( jpi_crs , jpj_crs , z2dcrs, ssh_crs2 ) 157 154 158 155 159 IF ( .NOT. ALLOCATED(ztsnm) ) THEN … … 187 191 ENDIF 188 192 189 IF ( .NOT. ALLOCATED(z2dcrsu) ) THEN 190 ALLOCATE( z2dcrsu(jpi_crs,jpj_crs) , z2dcrsv(jpi_crs,jpj_crs) , & 193 IF ( .NOT. ALLOCATED(z2dcrsf) ) THEN 194 !!cc1 IF ( .NOT. ALLOCATED(z2dcrsu) ) THEN 195 !!cc1 ALLOCATE( z2dcrsu(jpi_crs,jpj_crs) , z2dcrsv(jpi_crs,jpj_crs) , & 196 ALLOCATE( & 191 197 & z2dcrsf(jpi_crs,jpj_crs) , zhdivbt(jpi_crs,jpj_crs) , & 192 198 & zsshub(jpi_crs,jpj_crs) , zsshvb(jpi_crs,jpj_crs) , & … … 213 219 ENDIF 214 220 215 221 zw(:,:,:)=0.0 216 222 ! generic work arrays 217 223 z2d(:,:) = 0.0 … … 320 326 z3d(:,:,:) = tsn(:,:,:,jp_tem) 321 327 CALL crsfun( p_e1e2t=e1e2t, cd_type='T', cd_op='VOL', p_cmask=tmask_crs, p_ptmask=tmask, & 322 & p_pfield3d_1=zfse3t, p_pfield3d_2=z3d, p_cfield3d=z3dcrs ) 328 & p_pfield3d_1=zfse3t, p_pfield3d_2=z3d, p_cfield3d=z3dcrs ) 323 329 ztsn(:,:,:,1) = z3dcrs(:,:,:) 324 330 ztsnm(:,:,:,1) = ztsnm(:,:,:,1) + ztsn(:,:,:,1) … … 392 398 & p_fse3=zfse3v, p_pfield=z3d1, p_cfield3d=z3dcrs ) 393 399 zvsm(:,:,:) = zvsm(:,:,:) + z3dcrs(:,:,:) 400 401 402 ! Vitesse vertical !cc 403 z3dcrs(:,:,:) = 0.0 404 CALL crsfun( p_e1e2t=e1e2t, cd_type='T', cd_op='ARE', p_cmask=tmask_crs, p_ptmask=tmask, & 405 & p_pfield3d_1=wn, p_cfield3d=z3dcrs) 406 zw(:,:,:) = z3dcrs(:,:,:) 407 394 408 395 409 ! 2.5. Surface boundary conditions … … 495 509 zhdivbt(:,:) = 0.0 496 510 DO jk = 1, jpkm1 497 z2dcrsu(:,:) = 0.0; z2dcrsv(:,:) = 0.0511 !!cc1 z2dcrsu(:,:) = 0.0; z2dcrsv(:,:) = 0.0 498 512 DO ji = 2, jpi_crsm1 499 513 DO jj = 2, jpj_crsm1 … … 501 515 ! Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 502 516 ! with partial steps and/or variable layer thicknesses for W 503 z2dcrsu(ji,jj) = ( zum(ji, jj,jk) * crs_surfu_wgt(ji, jj,jk) ) & 517 !!cc1 z2dcrsu(ji,jj) = ( zum(ji, jj,jk) * crs_surfu_wgt(ji, jj,jk) ) & 518 z2dcrsu = ( zum(ji, jj,jk) * crs_surfu_wgt(ji, jj,jk) ) & 504 519 & - ( zum(ji-1,jj,jk) * crs_surfu_wgt(ji-1,jj,jk) ) 505 z2dcrsv(ji,jj) = ( zvm(ji,jj, jk) * crs_surfv_wgt(ji,jj ,jk) ) & 520 !!cc1 z2dcrsv(ji,jj) = ( zvm(ji,jj, jk) * crs_surfv_wgt(ji,jj ,jk) ) & 521 z2dcrsv = ( zvm(ji,jj, jk) * crs_surfv_wgt(ji,jj ,jk) ) & 506 522 & - ( zvm(ji,jj-1,jk) * crs_surfv_wgt(ji,jj-1,jk) ) 507 523 508 zhdiv(ji,jj,jk) = ( z2dcrsu(ji,jj) + z2dcrsv(ji,jj) ) * zvolt_wgt(ji,jj,jk) 524 !!cc1 zhdiv(ji,jj,jk) = ( z2dcrsu(ji,jj) + z2dcrsv(ji,jj) ) * zvolt_wgt(ji,jj,jk) 525 zhdiv(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) * zvolt_wgt(ji,jj,jk) 509 526 510 527 ENDDO … … 523 540 zhdivbtm(:,:) = zhdivbtm(:,:) + zhdivbt 524 541 525 526 ! 542 ! !!! Calcul de l'energie cinétique !cc !! DECLARE LES VARIABLES 543 ! 544 ! zun2(:,:,:) = un(:,:,:) * un(:,:,:) ! U^2 545 ! zvn2(:,:,:) = vn(:,:,:) * vn(:,:,:) ! V^2 546 ! 547 !! ! moyenne sur i de U^2 548 ! 549 ! DO ji = 1, jpiglo-1 550 ! zun2(ji,:,:) = 0.5 * (zun2(ji,:,:) + zun2(ji+1,:,:)) 551 ! END 552 ! ji = jpiglo 553 ! zun2(ji,:,:) = 0.5 * zun2(ji,:,:) 554 ! uun2(:,:,:) = zun2(:,:,:) 555 ! 556 ! 557 ! CALL crs_lbc_lnk( cd_type='T', 1.0, pt3d1=uun2) 558 ! ! lbcnlk met la ligne jpj = 1 a 0 donc il faut la remettre en ne pas oubliant le cyclique est-ouest 559 ! ! a faire un case pour cyclique est-ouest ou non. 560 ! uun2( : ,1,:) = zun2( : ,1,:) 561 ! 562 ! IF ((jperio==4) .OR. (jperio==6)) THEN 563 ! uun2( 1 ,1,:) = zun2(jpi_crsm1,1,:) 564 ! uun2(jpi_crs,1,:) = zun2( 2 ,1,:) 565 ! ENDIF 566 ! 567 ! 568 ! DO jj = 1, jpjglo-1 569 ! zvn2(:,jj,:) = 0.5 * (zvn2(:,jj,:) + zvn2(:,jj+1,:)) 570 ! END 571 ! jj = jpjglo 572 ! zvn2(:,jj,:) = 0.5 * zvn2(:,jj,:) 573 ! vvn2(:,:,:) = zvn2(:,:,:) 574 ! 575 ! CALL crs_lbc_lnk( cd_type='T', 1.0, pt3d1=vvn2) 576 ! ! lbcnlk met la ligne jpj = 1 a 0 donc il faut la remettre en ne pas oubliant le cyclique est-ouest 577 ! ! a faire un case pour cyclique est-ouest ou non. 578 ! vvn2( : ,1,:) = zvn2( : ,1,:) 579 ! 580 ! IF ((jperio==4) .OR. (jperio==6)) THEN 581 ! vvn2( 1 ,1,:) = zvn2(jpi_crsm1,1,:) 582 ! vvn2(jpi_crs,1,:) = zvn2( 2 ,1,:) 583 ! ENDIF 584 585 586 587 527 588 ! 2.6.3. Sea-surface Height ( See DOM/istate.F90: ssh init; OPA_SRC/DYN/sshwzv.F90: ssh update ) 589 !cc 590 z2dcrs(:,:) = 0.0 591 CALL crsfun( p_e1e2t=e1e2t, cd_type='T', cd_op='ARE', p_cmask=tmask_crs, p_ptmask=tmask, p_pfield2d=sshn, & 592 & p_cfield2d=z2dcrs ) 593 ssh_crs2(:,:) = z2dcrs(:,:) 594 ! WRITE(numout,*) 'test', sshn(:,:) 595 ! WRITE(numout,*) 'test', ssh_crs2(:,:) 596 597 !cc 598 528 599 ! set some temp variables 529 600 z2dcrs(:,:) = 0.0; z2dcrsf(:,:) = 0.0 … … 696 767 WRITE(numout,*) 'crsdiawri.', clmode 697 768 zrtsct = 1.0/REAL(itsct, wp) 769 698 770 ! 699 771 ! 3.1.2 Weights for spatial averages … … 710 782 CALL crs_iom_put( "toce_crs" , pv_r3d=tsn_crs(:,:,:,1) ) ! temperature 711 783 CALL crs_iom_put( "sst_crs" , pv_r2d=z2dcrs ) ! sst 784 712 785 ! 713 786 ! 3.1.4 Salinity … … 725 798 us_crs(:,:,:) = zusm(:,:,:) * zsuru(:,:,:) ! area-weighted- , time- mean 726 799 CALL crs_iom_put( "uoces_crs" , pv_r3d=us_crs ) ! uS 727 800 728 801 ! 3.1.6 V-velocity 729 802 vn_crs(:,:,:) = zvm(:,:,:) * zrtsct ! area-weighted- , time- mean … … 737 810 wn_crs(:,:,:) = zwm(:,:,:) * zrtsct ! area-weighted- , time- mean 738 811 CALL crs_iom_put( "woce_crs" , pv_r3d=wn_crs ) ! W-velocity 812 CALL crs_iom_put( "woce2_crs" , pv_r3d=zw ) ! cc 739 813 740 814 ! 3.1.8 Horizontal divergence 741 815 hdivn_crs(:,:,:) = zhdivnm(:,:,:) * zrtsct 742 CALL crs_iom_put( "hdivn_crs" , pv_r3d=hdivn_crs ) ! hdiv 816 ! CALL crs_iom_put( "hdivn_crs" , pv_r3d=hdivn_crs ) ! hdiv 817 CALL crs_iom_put( "hdiv_crs" , pv_r3d=hdivn_crs ) 818 743 819 hdivbt_crs(:,:) = zhdivbtm(:,:) * zrtsct 744 820 … … 758 834 ENDIF 759 835 CALL crs_iom_put( "ssh_crs" , pv_r2d=sshn_crs ) ! ssh output 760 836 CALL crs_iom_put( "ssh2_crs" , pv_r2d=ssh_crs2 ) !cc 761 837 762 838 ! 3.1.10 Potential density … … 866 942 CALL wrk_dealloc( jpi , jpj , jpk , zfse3u, zfse3v ) 867 943 CALL wrk_dealloc( jpi , jpj , jpk , zfse3t, zfse3w ) 868 CALL wrk_dealloc( jpi_crs , jpj_crs , jpk , z3dcrs ) 869 CALL wrk_dealloc( jpi_crs , jpj_crs , z2dcrs ) 870 871 DEALLOCATE( z2dcrsu, z2dcrsv, z2dcrsf, zhdivbt ) 944 CALL wrk_dealloc( jpi_crs , jpj_crs , jpk , z3dcrs, zw ) !cc 945 CALL wrk_dealloc( jpi_crs , jpj_crs , z2dcrs, ssh_crs2 ) 946 947 !!cc1 DEALLOCATE( z2dcrsu, z2dcrsv, z2dcrsf, zhdivbt ) ! probleme de malloc au 65 eme pas de temps 948 DEALLOCATE( z2dcrsf, zhdivbt ) ! probleme de malloc au 65 eme pas de temps 872 949 DEALLOCATE( zsshub, zsshua, zsshvb, zsshva ) 873 950 DEALLOCATE( zee_t, zee_f, zee_u, zee_v ) … … 876 953 DEALLOCATE( zhdiv, zvolt_wgt) 877 954 ! 955 878 956 IF( nn_timing == 1 ) CALL timing_stop('crs_dia_wri') 879 957 ! -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
r3622 r3778 137 137 !======================================================== 138 138 ! ! horizontal mesh (inum3) 139 CALL crs_iom_rstput( 0, 0, inum3, 'glamt _crs', pv_r2d=glamt_crs, ktype = jp_r4 ) ! ! latitude140 CALL crs_iom_rstput( 0, 0, inum3, 'glamu _crs', pv_r2d=glamu_crs, ktype = jp_r4 )141 CALL crs_iom_rstput( 0, 0, inum3, 'glamv _crs', pv_r2d=glamv_crs, ktype = jp_r4 )142 CALL crs_iom_rstput( 0, 0, inum3, 'glamf _crs', pv_r2d=glamf_crs, ktype = jp_r4 )143 144 CALL crs_iom_rstput( 0, 0, inum3, 'gphit _crs', pv_r2d=gphit_crs, ktype = jp_r4 ) ! ! longitude145 CALL crs_iom_rstput( 0, 0, inum3, 'gphiu _crs', pv_r2d=gphiu_crs, ktype = jp_r4 )146 CALL crs_iom_rstput( 0, 0, inum3, 'gphiv _crs', pv_r2d=gphiv_crs, ktype = jp_r4 )147 CALL crs_iom_rstput( 0, 0, inum3, 'gphif _crs', pv_r2d=gphif_crs, ktype = jp_r4 )148 149 CALL crs_iom_rstput( 0, 0, inum3, 'e1t _crs', pv_r2d=e1t_crs, ktype = jp_r8 ) ! ! e1 scale factors150 CALL crs_iom_rstput( 0, 0, inum3, 'e1u _crs', pv_r2d=e1u_crs, ktype = jp_r8 )151 CALL crs_iom_rstput( 0, 0, inum3, 'e1v _crs', pv_r2d=e1v_crs, ktype = jp_r8 )152 CALL crs_iom_rstput( 0, 0, inum3, 'e1f _crs', pv_r2d=e1f_crs, ktype = jp_r8 )153 154 CALL crs_iom_rstput( 0, 0, inum3, 'e2t _crs', pv_r2d=e2t_crs, ktype = jp_r8 ) ! ! e2 scale factors155 CALL crs_iom_rstput( 0, 0, inum3, 'e2u _crs', pv_r2d=e2u_crs, ktype = jp_r8 )156 CALL crs_iom_rstput( 0, 0, inum3, 'e2v _crs', pv_r2d=e2v_crs, ktype = jp_r8 )157 CALL crs_iom_rstput( 0, 0, inum3, 'e2f _crs', pv_r2d=e2f_crs, ktype = jp_r8 )139 CALL crs_iom_rstput( 0, 0, inum3, 'glamt', pv_r2d=glamt_crs, ktype = jp_r4 ) ! ! latitude 140 CALL crs_iom_rstput( 0, 0, inum3, 'glamu', pv_r2d=glamu_crs, ktype = jp_r4 ) 141 CALL crs_iom_rstput( 0, 0, inum3, 'glamv', pv_r2d=glamv_crs, ktype = jp_r4 ) 142 CALL crs_iom_rstput( 0, 0, inum3, 'glamf', pv_r2d=glamf_crs, ktype = jp_r4 ) 143 144 CALL crs_iom_rstput( 0, 0, inum3, 'gphit', pv_r2d=gphit_crs, ktype = jp_r4 ) ! ! longitude 145 CALL crs_iom_rstput( 0, 0, inum3, 'gphiu', pv_r2d=gphiu_crs, ktype = jp_r4 ) 146 CALL crs_iom_rstput( 0, 0, inum3, 'gphiv', pv_r2d=gphiv_crs, ktype = jp_r4 ) 147 CALL crs_iom_rstput( 0, 0, inum3, 'gphif', pv_r2d=gphif_crs, ktype = jp_r4 ) 148 149 CALL crs_iom_rstput( 0, 0, inum3, 'e1t', pv_r2d=e1t_crs, ktype = jp_r8 ) ! ! e1 scale factors 150 CALL crs_iom_rstput( 0, 0, inum3, 'e1u', pv_r2d=e1u_crs, ktype = jp_r8 ) 151 CALL crs_iom_rstput( 0, 0, inum3, 'e1v', pv_r2d=e1v_crs, ktype = jp_r8 ) 152 CALL crs_iom_rstput( 0, 0, inum3, 'e1f', pv_r2d=e1f_crs, ktype = jp_r8 ) 153 154 CALL crs_iom_rstput( 0, 0, inum3, 'e2t', pv_r2d=e2t_crs, ktype = jp_r8 ) ! ! e2 scale factors 155 CALL crs_iom_rstput( 0, 0, inum3, 'e2u', pv_r2d=e2u_crs, ktype = jp_r8 ) 156 CALL crs_iom_rstput( 0, 0, inum3, 'e2v', pv_r2d=e2v_crs, ktype = jp_r8 ) 157 CALL crs_iom_rstput( 0, 0, inum3, 'e2f', pv_r2d=e2f_crs, ktype = jp_r8 ) 158 158 159 159 CALL crs_iom_rstput( 0, 0, inum3, 'ff_crs', pv_r2d=ff_crs, ktype = jp_r8 ) ! ! coriolis factor … … 167 167 IF( ln_zps ) THEN ! z-coordinate - partial steps 168 168 169 169 170 IF ( nn_msh_crs <= 6 ) THEN 170 CALL crs_iom_rstput( 0, 0, inum4, 'e3t _crs', pv_r3d=fse3t_crs )171 CALL crs_iom_rstput( 0, 0, inum4, 'e3w _crs', pv_r3d=fse3w_crs )172 CALL crs_iom_rstput( 0, 0, inum4, 'e3u _crs', pv_r3d=fse3u_crs )173 CALL crs_iom_rstput( 0, 0, inum4, 'e3v _crs', pv_r3d=fse3v_crs )171 CALL crs_iom_rstput( 0, 0, inum4, 'e3t', pv_r3d=e3t_crs ) 172 CALL crs_iom_rstput( 0, 0, inum4, 'e3w', pv_r3d=e3w_crs ) 173 CALL crs_iom_rstput( 0, 0, inum4, 'e3u', pv_r3d=e3u_crs ) 174 CALL crs_iom_rstput( 0, 0, inum4, 'e3v', pv_r3d=e3v_crs ) 174 175 ELSE 175 176 DO jj = 1,jpj_crs … … 188 189 189 190 IF ( nn_msh_crs <= 3 ) THEN 190 CALL crs_iom_rstput( 0, 0, inum4, 'gdept_crs', pv_r3d=gdept_crs, ktype = jp_r4 ) 191 CALL crs_iom_rstput( 0, 0, inum4, 'gdept_crs', pv_r3d=gdept_crs, ktype = jp_r4 ) 191 192 DO jk = 1,jpk 192 193 DO jj = 1, jpj_crsm1 … … 219 220 220 221 CALL crs_iom_rstput( 0, 0, inum4, 'ocean_volume_crs_t', pv_r3d=ocean_volume_crs_t ) 221 CALL crs_iom_rstput( 0, 0, inum4, 'facvol_t', pv_r3d=facvol_t ) 222 CALL crs_iom_rstput( 0, 0, inum4, 'facvol_w', pv_r3d=facvol_w ) 223 CALL crs_iom_rstput( 0, 0, inum4, 'facsurfu', pv_r3d=facsurfu ) 224 CALL crs_iom_rstput( 0, 0, inum4, 'facsurfv', pv_r3d=facsurfv ) 222 CALL crs_iom_rstput( 0, 0, inum4, 'facvol_t' , pv_r3d=facvol_t ) 223 CALL crs_iom_rstput( 0, 0, inum4, 'facvol_w' , pv_r3d=facvol_w ) 224 CALL crs_iom_rstput( 0, 0, inum4, 'facsurfu' , pv_r3d=facsurfu ) 225 CALL crs_iom_rstput( 0, 0, inum4, 'facsurfv' , pv_r3d=facsurfv ) 226 CALL crs_iom_rstput( 0, 0, inum4, 'e1e2w_msk', pv_r3d=e1e2w_msk) 227 CALL crs_iom_rstput( 0, 0, inum4, 'e2e3u_msk', pv_r3d=e2e3u_msk) 228 CALL crs_iom_rstput( 0, 0, inum4, 'e1e3v_msk', pv_r3d=e1e3v_msk) 229 CALL crs_iom_rstput( 0, 0, inum4, 'e1e2w' , pv_r3d=e1e2w ) 230 CALL crs_iom_rstput( 0, 0, inum4, 'e2e3u' , pv_r3d=e2e3u ) 231 CALL crs_iom_rstput( 0, 0, inum4, 'e1e3v' , pv_r3d=e1e3v ) 232 CALL crs_iom_rstput( 0, 0, inum4, 'bt_crs' , pv_r3d=bt_crs ) 233 CALL crs_iom_rstput( 0, 0, inum4, 'r1_bt_crs', pv_r3d=r1_bt_crs) 225 234 226 235 CALL crs_iom_rstput( 0, 0, inum4, 'crs_surfu_wgt', pv_r3d=crs_surfu_wgt) -
branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r3738 r3778 193 193 194 194 DO ji = 2, jpiglo_crsm1 195 ijie = (ji*nn_factx)-nn_factx+1 195 !cc ijie = (ji*nn_factx)-nn_factx+1 196 ijie = (ji*nn_factx)-nn_factx !cc 196 197 ijis = ijie-nn_factx+1 197 198 198 199 IF ( ji == jpiglo_crsm1 ) THEN 199 IF ( ((jpiglo-1)-ijie) <= nn_factx ) ijie = jpiglo-1200 IF ( ((jpiglo-1)-ijie) <= nn_factx ) ijie = jpiglo-2 ! ijie = jpiglo-1 !cc 200 201 ENDIF 201 202 … … 207 208 ENDIF 208 209 209 DO jj = 2, jpjglo_crsm1 210 ijje = ijjgloT-nn_facty*(jj-2) 210 DO jj = 2, jpjglo_crsm1 211 ! cc ijje = ijjgloT-nn_facty*(jj-2) 212 ijje = ijjgloT-nn_facty*(jj-2) - 1 211 213 ijjs = ijje-nn_facty+1 212 214 … … 271 273 272 274 ! Pad the boundaries, do not know if it is necessary 273 mis_crs(1) = 1 ; mis_crs(jpiglo_crs) = jpiglo274 mie_crs(1) = 1; mie_crs(jpiglo_crs) = jpiglo275 mjs_crs(1) = 1 ; mjs_crs(jpjglo_crs) = jpjglo276 mje_crs(1) = 1; mje_crs(jpjglo_crs) = jpjglo275 mis_crs(1) = 1 ; mis_crs(jpiglo_crs) = mie_crs(jpiglo_crs - 1) + 1 !cc 276 mie_crs(1) = nn_factx ; mie_crs(jpiglo_crs) = jpiglo !cc 277 mjs_crs(1) = 1 ; mjs_crs(jpjglo_crs) = mje_crs(jpjglo_crs - 1) + 1 278 mje_crs(1) = mjs_crs(2)-1; mje_crs(jpjglo_crs) = jpjglo 277 279 278 280 ! WRITE(numout,*) 'crs_init. coarse grid bounds on parent grid' … … 313 315 WRITE(numout,*) 'crsini. count 1' 314 316 315 ! CALL crsfun( gphiu, glamu, 'U', gphiu_crs, glamu_crs ) 316 ! WRITE(numout,*) 'crsini. gphiu_crs(15,15)', gphiu_crs(15,15) 317 ! WRITE(numout,*) 'crsini. glamu_crs(15,15)', glamu_crs(15,15) 317 CALL crsfun( gphiu, glamu, 'U', gphiu_crs, glamu_crs ) !cc 318 WRITE(numout,*) 'crsini. gphiu_crs(15,15)', gphiu_crs(15,15) !cc 319 WRITE(numout,*) 'crsini. glamu_crs(15,15)', glamu_crs(15,15) !cc 318 320 WRITE(numout,*) 'crsini. count 2' 319 321 320 ! CALL crsfun( p_pgphi=gphiv, p_pglam=glamv, cd_type='V', p_cgphi=gphiv_crs, p_cglam=glamv_crs ) 321 ! WRITE(numout,*) 'crsini. gphiv_crs(15,15)', gphiv_crs(15,15) 322 ! WRITE(numout,*) 'crsini. glamv_crs(15,15)', glamv_crs(15,15) 322 CALL crsfun( p_pgphi=gphiv, p_pglam=glamv, cd_type='V', p_cgphi=gphiv_crs, p_cglam=glamv_crs ) !cc 323 WRITE(numout,*) 'crsini. gphiv_crs(15,15)', gphiv_crs(15,15) !cc 324 WRITE(numout,*) 'crsini. glamv_crs(15,15)', glamv_crs(15,15) !cc 323 325 324 326 WRITE(numout,*) 'crsini. count 3' 325 ! CALL crsfun( p_pgphi=gphif, p_pglam=glamf, cd_type='F', p_cgphi=gphif_crs, p_cglam=glamf_crs ) 326 ! WRITE(numout,*) 'crsini. gphif_crs(15,15)', gphif_crs(15,15) 327 ! WRITE(numout,*) 'crsini. glamf_crs(15,15)', glamf_crs(15,15) 327 CALL crsfun( p_pgphi=gphif, p_pglam=glamf, cd_type='F', p_cgphi=gphif_crs, p_cglam=glamf_crs ) !cc 328 WRITE(numout,*) 'crsini. gphif_crs(15,15)', gphif_crs(15,15) !cc 329 WRITE(numout,*) 'crsini. glamf_crs(15,15)', glamf_crs(15,15) !cc 328 330 329 331 WRITE(numout,*) 'crsini. count 4' … … 350 352 351 353 ! 3.c.1 Horizontal scale factors 352 CALL crsfun( cd_type='T', cd_op='SUM', p_pmask=tmask, p_e1=e1t, p_e2=e2t, p_cfield2d_1=e1t_crs, p_cfield2d_2=e2t_crs ) 353 CALL crsfun( cd_type='U', cd_op='SUM', p_pmask=umask, p_e1=e1u, p_e2=e2u, p_cfield2d_1=e1u_crs, p_cfield2d_2=e2u_crs ) 354 CALL crsfun( cd_type='V', cd_op='SUM', p_pmask=vmask, p_e1=e1v, p_e2=e2v, p_cfield2d_1=e1v_crs, p_cfield2d_2=e2v_crs ) 355 CALL crsfun( cd_type='F', cd_op='SUM', p_pmask=fmask, p_e1=e1f, p_e2=e2f, p_cfield2d_1=e1f_crs, p_cfield2d_2=e2f_crs ) 354 ! CALL crsfun( cd_type='T', cd_op='SUM', p_pmask=tmask, p_e1=e1t, p_e2=e2t, p_cfield2d_1=e1t_crs, p_cfield2d_2=e2t_crs ) 355 ! CALL crsfun( cd_type='U', cd_op='SUM', p_pmask=umask, p_e1=e1u, p_e2=e2u, p_cfield2d_1=e1u_crs, p_cfield2d_2=e2u_crs ) 356 ! CALL crsfun( cd_type='V', cd_op='SUM', p_pmask=vmask, p_e1=e1v, p_e2=e2v, p_cfield2d_1=e1v_crs, p_cfield2d_2=e2v_crs ) 357 ! CALL crsfun( cd_type='F', cd_op='SUM', p_pmask=fmask, p_e1=e1f, p_e2=e2f, p_cfield2d_1=e1f_crs, p_cfield2d_2=e2f_crs ) 358 CALL crsfun( cd_type='T', cd_op='POS', p_pmask=tmask, p_e1=e1t, p_e2=e2t, p_cfield2d_1=e1t_crs, p_cfield2d_2=e2t_crs ) 359 CALL crsfun( cd_type='U', cd_op='POS', p_pmask=umask, p_e1=e1u, p_e2=e2u, p_cfield2d_1=e1u_crs, p_cfield2d_2=e2u_crs ) 360 CALL crsfun( cd_type='V', cd_op='POS', p_pmask=vmask, p_e1=e1v, p_e2=e2v, p_cfield2d_1=e1v_crs, p_cfield2d_2=e2v_crs ) 361 CALL crsfun( cd_type='F', cd_op='POS', p_pmask=fmask, p_e1=e1f, p_e2=e2f, p_cfield2d_1=e1f_crs, p_cfield2d_2=e2f_crs ) 356 362 357 363 e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:) … … 440 446 zfse3f(:,:,:) = fse3f(:,:,:) 441 447 zfse3w(:,:,:) = fse3w(:,:,:) 442 443 CALL crsfun( p_e1e2t=e1e2t, cd_type='T', cd_op='MAX', p_cmask=tmask_crs, p_ptmask=tmask, p_pfield3d_1=zfse3t, p_cfield3d=e3t_crs ) 444 CALL crsfun( p_e1e2t=e1e2t, cd_type='W', cd_op='MAX', p_cmask=tmask_crs, p_ptmask=tmask, p_pfield3d_1=zfse3w, p_cfield3d=e3w_crs ) 445 CALL crsfun( p_e1e2t=e1e2t, cd_type='U', cd_op='MIN', p_cmask=umask_crs, p_ptmask=umask, p_pfield3d_1=zfse3u, p_cfield3d=e3u_crs ) 446 CALL crsfun( p_e1e2t=e1e2t, cd_type='V', cd_op='MIN', p_cmask=vmask_crs, p_ptmask=vmask, p_pfield3d_1=zfse3v, p_cfield3d=e3v_crs ) 447 CALL crsfun( p_e1e2t=e1e2t, cd_type='F', cd_op='MIN', p_cmask=fmask_crs, p_ptmask=fmask, p_pfield3d_1=zfse3f, p_cfield3d=e3f_crs ) 448 448 449 450 451 !CALL crsfun( p_e1e2t=e1e2t, cd_type='T', cd_op='MAX', p_cmask=tmask_crs, p_ptmask=tmask, p_pfield3d_1=zfse3t, p_cfield3d=e3t_crs ) 452 !CALL crsfun( p_e1e2t=e1e2t, cd_type='W', cd_op='MAX', p_cmask=tmask_crs, p_ptmask=tmask, p_pfield3d_1=zfse3w, p_cfield3d=e3w_crs ) 453 !CALL crsfun( p_e1e2t=e1e2t, cd_type='U', cd_op='MIN', p_cmask=umask_crs, p_ptmask=umask, p_pfield3d_1=zfse3u, p_cfield3d=e3u_crs ) 454 !CALL crsfun( p_e1e2t=e1e2t, cd_type='V', cd_op='MIN', p_cmask=vmask_crs, p_ptmask=vmask, p_pfield3d_1=zfse3v, p_cfield3d=e3v_crs ) 455 !CALL crsfun( p_e1e2t=e1e2t, cd_type='F', cd_op='MIN', p_cmask=fmask_crs, p_ptmask=fmask, p_pfield3d_1=zfse3f, p_cfield3d=e3f_crs ) 456 CALL crs_e3_max( p_e3=zfse3t, cd_type='T', p_mask=tmask, p_e3_crs=e3t_crs) 457 CALL crs_e3_max( p_e3=zfse3w, cd_type='W', p_mask=tmask, p_e3_crs=e3w_crs) 458 449 459 ! Reset 0 to e3t_0 or e3w_0 450 460 DO jk = 1, jpk … … 465 475 CALL crsfun( p_e1e2t=e1e2t, cd_type='W', cd_op='MAX', p_cmask=tmask_crs, p_ptmask=tmask, p_pfield3d_1=gdepw, p_cfield3d=gdepw_crs ) 466 476 467 477 ! 3.d.4 Surfaces 478 479 CALL crs_surf(p_e1=e1t, p_e2=e2t ,p_e3=zfse3w, cd_type='W', p_mask=tmask, surf_crs=e1e2w, surf_msk_crs=e1e2w_msk) 480 CALL crs_surf(p_e1=e1u, p_e2=e2u ,p_e3=zfse3u, cd_type='U', p_mask=umask, surf_crs=e2e3u, surf_msk_crs=e2e3u_msk) 481 CALL crs_surf(p_e1=e1v, p_e2=e2v ,p_e3=zfse3v, cd_type='V', p_mask=vmask, surf_crs=e1e3v, surf_msk_crs=e1e3v_msk) 468 482 469 483 … … 476 490 CALL crsfun( cd_type='T', cd_op='VOL', p_pmask=tmask, p_e1=e1t, p_e2=e2t, p_fse3=zfse3t, & 477 491 & p_cfield3d_1=ocean_volume_crs_t, p_cfield3d_2=facvol_t ) 492 493 r1_bt_crs(:,:,:) = 0._wp 494 bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:)* facvol_t(:,:,:) 495 WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp/bt_crs(:,:,:) 478 496 479 497 CALL crsfun( cd_type='W', cd_op='VOL', p_pmask=tmask, p_e1=e1t, p_e2=e2t, p_fse3=zfse3w, & … … 495 513 ! 5. Write out coarse meshmask (see OPA_SRC/DOM/domwri.F90 for ideas later) 496 514 !--------------------------------------------------------- 497 498 515 IF ( nn_msh_crs > 0 ) CALL crs_dom_wri 499 516
Note: See TracChangeset
for help on using the changeset viewer.
