Changeset 5105
- Timestamp:
- 2015-02-24T15:46:25+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
- Files:
-
- 14 added
- 18 edited
-
OPA_SRC/CRS/crs.F90 (modified) (8 diffs)
-
OPA_SRC/CRS/crsdom.F90 (modified) (21 diffs)
-
OPA_SRC/CRS/crsfld.F90 (modified) (12 diffs)
-
OPA_SRC/CRS/crsini.F90 (modified) (7 diffs)
-
OPA_SRC/DOM/dom_oce.F90 (modified) (2 diffs)
-
OPA_SRC/IOM/iom.F90 (modified) (1 diff)
-
OPA_SRC/LDF/ldfslp_crs.F90 (added)
-
OPA_SRC/TRA/eosbn2_crs.F90 (added)
-
OPA_SRC/TRA/traadv_tvd_crs.F90 (added)
-
OPA_SRC/TRA/trabbl_crs.F90 (added)
-
OPA_SRC/TRA/traldf_iso_crs.F90 (added)
-
OPA_SRC/TRA/traldf_lap_crs.F90 (added)
-
OPA_SRC/TRA/trazdf_imp_crs.F90 (added)
-
OPA_SRC/TRA/zpshde_crs.F90 (added)
-
OPA_SRC/ZDF/zdfmxl_crs.F90 (added)
-
OPA_SRC/nemogcm.F90 (modified) (2 diffs)
-
OPA_SRC/step.F90 (modified) (3 diffs)
-
OPA_SRC/step_oce.F90 (modified) (1 diff)
-
TOP_SRC/MY_TRC/trcwri_my_trc.F90 (modified) (3 diffs)
-
TOP_SRC/TRP/trcadv_crs.F90 (added)
-
TOP_SRC/TRP/trcbbl_crs.F90 (added)
-
TOP_SRC/TRP/trcldf_crs.F90 (added)
-
TOP_SRC/TRP/trcsbc_crs.F90 (added)
-
TOP_SRC/TRP/trctrp.F90 (modified) (6 diffs)
-
TOP_SRC/TRP/trczdf_crs.F90 (added)
-
TOP_SRC/oce_trc.F90 (modified) (5 diffs)
-
TOP_SRC/trcdia.F90 (modified) (1 diff)
-
TOP_SRC/trcdta.F90 (modified) (1 diff)
-
TOP_SRC/trcini.F90 (modified) (4 diffs)
-
TOP_SRC/trcrst.F90 (modified) (2 diffs)
-
TOP_SRC/trcstp.F90 (modified) (2 diffs)
-
TOP_SRC/trcsub.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r5010 r5105 94 94 95 95 ! Masks 96 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs97 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs96 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: tmask_crs, umask_crs, vmask_crs, fmask_crs 97 REAL(wp), DIMENSION(:,:) , ALLOCATABLE,SAVE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 98 98 99 99 ! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmask_i_crs, tpol, fpol … … 112 112 ! vertical scale factors 113 113 ! Coordinates 114 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs115 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs116 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ff_crs117 INTEGER, DIMENSION(:,:), ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs118 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs114 REAL(wp), DIMENSION(:,:), ALLOCATABLE,SAVE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 115 REAL(wp), DIMENSION(:,:), ALLOCATABLE,SAVE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 116 REAL(wp), DIMENSION(:,:), ALLOCATABLE,SAVE :: ff_crs 117 INTEGER, DIMENSION(:,:), ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs 118 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs 119 119 120 120 ! Weights … … 136 136 INTEGER :: nn_crs_kz = 0 !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 137 137 LOGICAL :: ln_crs_wn = .FALSE. !: coarsening wn or computation using horizontal divergence 138 LOGICAL, PUBLIC :: ln_crs_top = .FALSE. !:coarsening online for the bio 138 139 ! 139 140 INTEGER :: nrestx, nresty !: for determining odd or even reduction factor … … 146 147 147 148 ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 148 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ts n_crs149 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tsb_crs,tsn_crs 149 150 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: un_crs, vn_crs, wn_crs, rke_crs 150 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: hdivn_crs 151 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: sshn_crs 151 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ub_crs, vb_crs 152 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: hdivb_crs , hdivn_crs 153 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: sshb_crs, sshn_crs , ssha_crs 154 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: rhop_crs,rhd_crs,rb2_crs 155 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: gru_crs, grv_crs 156 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: gtsu_crs, gtsv_crs 152 157 ! 153 158 ! Surface fluxes to pass to TOP 154 159 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs 155 160 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs 161 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: fmmflx_crs 156 162 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: utau_crs, vtau_crs 157 163 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: rnf_crs … … 164 170 165 171 ! Mixing and Mixed Layer Depth 166 INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs 172 INTEGER, PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: nmln_crs 173 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: hmlp_crs , hmlpt_crs , hmld_crs 167 174 168 175 ! Direction of lateral diffusion … … 235 242 236 243 237 ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , & 238 & wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),& 239 & rke_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(11)) 240 241 ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 244 ALLOCATE( ub_crs(jpi_crs,jpj_crs,jpk) , vb_crs(jpi_crs,jpj_crs,jpk) , & 245 & un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , wn_crs(jpi_crs,jpj_crs,jpk) , & 246 & hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , & 247 & rke_crs(jpi_crs,jpj_crs,jpk), rhop_crs(jpi_crs,jpj_crs,jpk) , & 248 & rb2_crs(jpi_crs,jpj_crs,jpk) ,rhd_crs(jpi_crs,jpj_crs,jpk) , & 249 & gtsu_crs(jpi_crs,jpj_crs,jpk) ,gtsv_crs(jpi_crs,jpj_crs,jpk) , & 250 gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11)) 251 252 ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs), ssha_crs(jpi_crs,jpj_crs), & 253 & emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 242 254 & qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 243 255 & vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), & 244 & fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) )245 246 ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk), &256 & fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) ) 257 258 ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsb_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk), & 247 259 # if defined key_zdfddm 248 260 & avs_crs(jpi_crs,jpj_crs,jpk), & … … 302 314 !! ** Purpose : +Return back to parent grid domain 303 315 !!--------------------------------------------------------------------- 304 write(narea+200,*)"dom_grid_glo";call flush(narea+200)305 316 306 317 ! Return to parent grid domain … … 346 357 !! ** Purpose : Save the parent grid information & Switch to coarse grid domain 347 358 !!--------------------------------------------------------------------- 348 write(narea+200,*)"dom_grid_crs";call flush(narea+200)349 359 ! 350 360 ! Switch to coarse grid domain -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r5010 r5105 52 52 END INTERFACE 53 53 54 REAL(wp) :: r_inf =1e+3654 REAL(wp),PUBLIC :: r_inf = 1e+7 !cbr 1e+36 55 55 56 56 !! Substitutions … … 64 64 INTEGER :: ji, jj, jk ! dummy loop indices 65 65 INTEGER :: ijie,ijis,ijje,ijjs,ij,je_2 66 INTEGER :: iji, ijj 66 67 REAL(wp) :: zmask 67 68 … … 122 123 ijjs = mjs_crs(jj) 123 124 124 IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 125 !iji=117 ; ijj=211 126 !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 127 !IF( ji ==iji .AND. jj==ijj .AND. jk==74 )THEN 128 !write(narea+5000,*)"mask ",ji,jj 129 !write(narea+5000,*)"mask ",ijie,ijis,ijjs,ijje 130 !ENDIF 131 132 !IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 125 133 zmask = 0.0 126 134 zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) … … 140 148 ENDDO 141 149 ENDDO 150 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 151 !cbr 152 !DO ji=1,jpi_crs-1 153 !DO jj=1,jpj_crs-1 154 !DO jk=1,jpk 155 ! umask_crs(ji,jj,jk) = tmask_crs(ji ,jj ,jk) * tmask_crs(ji+1,jj ,jk) 156 ! vmask_crs(ji,jj,jk) = tmask_crs(ji ,jj ,jk) * tmask_crs(ji ,jj+1,jk) 157 ! fmask_crs(ji,jj,jk) = tmask_crs(ji ,jj ,jk) * tmask_crs(ji ,jj+1,jk) * tmask_crs(ji+1,jj ,jk) * tmask_crs(ji+1,jj+1,jk) 158 !ENDDO 159 !ENDDO 160 !ENDDO 142 161 ! 143 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )144 162 CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 ) 145 163 CALL crs_lbc_lnk( umask_crs, 'U', 1.0 ) 146 164 CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 ) 165 ! 166 !cbr 167 !DO ji=2,jpi_crs-1 168 !DO jj=2,jpj_crs-1 169 !DO jk=1,jpk 170 ! IF( tmask(ji-1,jj ,jk)==1. .AND. tmask(ji ,jj ,jk)==1. .AND. umask(ji-1,jj ,jk)==0. )WRITE(narea+5000,*)"MASK1",ji,jj,jk 171 ! IF( tmask(ji ,jj ,jk)==1. .AND. tmask(ji+1,jj ,jk)==1. .AND. umask(ji ,jj ,jk)==0. )WRITE(narea+5000,*)"MASK2",ji,jj,jk 172 ! IF( tmask(ji ,jj-1,jk)==1. .AND. tmask(ji ,jj ,jk)==1. .AND. vmask(ji ,jj-1,jk)==0. )WRITE(narea+5000,*)"MASK3",ji,jj,jk 173 ! IF( tmask(ji ,jj ,jk)==1. .AND. tmask(ji ,jj+1,jk)==1. .AND. vmask(ji ,jj ,jk)==0. )WRITE(narea+5000,*)"MASK4",ji,jj,jk 174 ! IF( umask(ji-1,jj ,jk)==1. .AND. ( tmask(ji-1,jj ,jk)==0. .OR. tmask(ji ,jj ,jk)==0. ) )WRITE(narea+5000,*)"MASK5",ji,jj,jk 175 ! IF( umask(ji ,jj ,jk)==1. .AND. ( tmask(ji ,jj ,jk)==0. .OR. tmask(ji+1,jj ,jk)==0. ) )WRITE(narea+5000,*)"MASK6",ji,jj,jk 176 ! IF( vmask(ji ,jj-1,jk)==1. .AND. ( tmask(ji ,jj-1,jk)==0. .OR. tmask(ji ,jj ,jk)==0. ) )WRITE(narea+5000,*)"MASK7",ji,jj,jk 177 ! IF( vmask(ji ,jj ,jk)==1. .AND. ( tmask(ji ,jj ,jk)==0. .OR. tmask(ji ,jj+1,jk)==0. ) )WRITE(narea+5000,*)"MASK8",ji,jj,jk 178 !ENDDO 179 !ENDDO 180 !ENDDO 147 181 ! 148 182 END SUBROUTINE crs_dom_msk … … 385 419 386 420 zmask(:,:,:) = 0.0 387 IF( cd_type == 'W' ) THEN388 zmask(:,:,1) = p_mask(:,:,1)389 DO jk = 2, jpk390 zmask(:,:,jk) = p_mask(:,:,jk-1)391 ENDDO392 ELSE421 !IF( cd_type == 'W' ) THEN 422 ! zmask(:,:,1) = p_mask(:,:,1) 423 ! DO jk = 2, jpk 424 ! zmask(:,:,jk) = p_mask(:,:,jk-1) 425 ! ENDDO 426 !ELSE 393 427 DO jk = 1, jpk 394 428 zmask(:,:,jk) = p_mask(:,:,jk) 395 429 ENDDO 396 ENDIF430 !ENDIF 397 431 398 432 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 … … 513 547 REAL(wp) :: zflcrs, zsfcrs 514 548 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask 549 INTEGER :: iji, ijj 515 550 !!---------------------------------------------------------------- 516 551 … … 526 561 527 562 CASE( 'T', 'W' ) 528 IF( cd_type == 'T' ) THEN563 !IF( cd_type == 'T' ) THEN 529 564 DO jk = 1, jpk 530 565 zsurf (:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) 531 566 zsurfmsk(:,:,jk) = zsurf(:,:,jk) 532 567 ENDDO 533 ELSE 534 zsurf (:,:,1) = p_e12(:,:) * p_e3(:,:,1) 535 zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 536 DO jk = 2, jpk 537 zsurf (:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) 538 zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 539 ENDDO 540 ENDIF 568 !ELSE 569 ! !cbr ???????????????????????????????? 570 ! zsurf (:,:,1) = p_e12(:,:) * p_e3(:,:,1) 571 ! zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 572 ! DO jk = 2, jpk 573 ! zsurf (:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) 574 ! zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 575 ! ENDDO 576 !ENDIF 541 577 542 578 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 … … 619 655 CASE( 'W' ) 620 656 IF( PRESENT( p_e3 ) ) THEN 621 zsurfmsk(:,:,1) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 622 DO jk = 2, jpk 623 zsurfmsk(:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1) 657 !cbr ????????????? 658 !zsurfmsk(:,:,1) = p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 659 !DO jk = 2, jpk 660 ! zsurfmsk(:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1) 661 !ENDDO 662 DO jk = 1, jpk 663 zsurfmsk(:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) 624 664 ENDDO 625 665 ELSE 626 zsurfmsk(:,:,1) = p_e12(:,:) * p_mask(:,:,1) 627 DO jk = 2, jpk 628 zsurfmsk(:,:,jk) = p_e12(:,:) * p_mask(:,:,jk-1) 666 !zsurfmsk(:,:,1) = p_e12(:,:) * p_mask(:,:,1) 667 !DO jk = 2, jpk 668 ! zsurfmsk(:,:,jk) = p_e12(:,:) * p_mask(:,:,jk-1) 669 !ENDDO 670 DO jk = 1, jpk 671 zsurfmsk(:,:,jk) = p_e12(:,:) * p_mask(:,:,jk) 629 672 ENDDO 630 673 ENDIF … … 712 755 & + p_fld(ji+2,jj ,jk) * zsurfmsk(ji+2,jj ,jk) 713 756 714 zsfcrs = zsurfmsk(ji ,jj ,jk) &715 & + zsurfmsk(ji+1,jj ,jk) &716 & + zsurfmsk(ji+2,jj ,jk)717 718 IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs719 ELSE ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs720 ENDIF757 !zsfcrs = zsurfmsk(ji ,jj ,jk) & 758 ! & + zsurfmsk(ji+1,jj ,jk) & 759 ! & + zsurfmsk(ji+2,jj ,jk) 760 761 !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 762 !ELSE ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 763 !ENDIF 721 764 ENDIF 722 765 ELSE … … 726 769 & + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 727 770 ! 728 zsfcrs = zsurfmsk(ji ,ijje,jk) & 729 & + zsurfmsk(ji+1,ijje,jk) & 730 & + zsurfmsk(ji+2,ijje,jk) 731 732 IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 733 ELSE ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 734 ENDIF 771 !zsfcrs = zsurfmsk(ji ,ijje,jk) & 772 ! & + zsurfmsk(ji+1,ijje,jk) & 773 ! & + zsurfmsk(ji+2,ijje,jk) 774 775 p_fld_crs(ii,2,jk) = zflcrs 776 !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 777 !ELSE ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 778 !ENDIF 735 779 736 780 ENDIF … … 746 790 & + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 747 791 ! 748 zsfcrs = zsurfmsk(ji ,ijje,jk) & 749 & + zsurfmsk(ji+1,ijje,jk) & 750 & + zsurfmsk(ji+2,ijje,jk) 751 752 IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs 753 ELSE ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 754 ENDIF 792 !zsfcrs = zsurfmsk(ji ,ijje,jk) & 793 ! & + zsurfmsk(ji+1,ijje,jk) & 794 ! & + zsurfmsk(ji+2,ijje,jk) 795 796 p_fld_crs(ii,ij,jk) = zflcrs 797 !cbr1 798 !iji=117 ; ijj=210 799 !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 800 !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 801 !WRITE(narea+5000,*)"OPE V =======> " 802 !WRITE(narea+5000,*)ii,ij,jk 803 !WRITE(narea+5000,*)ji,jj,ijje 804 !WRITE(narea+5000,*)p_fld(ji ,ijje,jk) 805 !WRITE(narea+5000,*)p_fld(ji+1,ijje,jk) 806 !WRITE(narea+5000,*)p_fld(ji+2,ijje,jk) 807 !WRITE(narea+5000,*)zflcrs 808 !ENDIF 809 810 !IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs 811 !ELSE ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 812 !ENDIF 755 813 ! 814 !IF( ii==iji .AND. ij==ijj .AND. jk==74 )WRITE(narea+5000,*)" p_fld_crs(ii,ij,jk) = ", p_fld_crs(ii,ij,jk) 756 815 ENDDO 757 816 ENDDO … … 809 868 ENDIF 810 869 870 !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) end SUM = ",p_fld(17,5,74) 811 871 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk ) 812 872 … … 987 1047 CALL wrk_alloc( jpi, jpj, jpk, zmask ) 988 1048 989 SELECT CASE ( cd_type ) 990 CASE( 'W' ) 991 zmask(:,:,1) = p_mask(:,:,1) 992 DO jk = 2, jpk 993 zmask(:,:,jk) = p_mask(:,:,jk-1) 994 ENDDO 995 CASE ( 'T' ) 1049 !SELECT CASE ( cd_type ) 1050 ! CASE( 'W' ) 1051 ! !cbr ????????????????????????????? 1052 ! zmask(:,:,1) = p_mask(:,:,1) 1053 ! DO jk = 2, jpk 1054 ! zmask(:,:,jk) = p_mask(:,:,jk-1) 1055 ! ENDDO 1056 ! CASE ( 'T' ) 996 1057 DO jk = 1, jpk 997 1058 zmask(:,:,jk) = p_mask(:,:,jk) 998 1059 ENDDO 999 END SELECT1060 !END SELECT 1000 1061 1001 1062 SELECT CASE ( cd_type ) … … 1157 1218 END SELECT 1158 1219 ! 1220 !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) avt lbc = ",p_fld(17,5,74) 1159 1221 CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn ) 1222 !IF(narea==267)WRITE(5000+narea,*)"vn_crs(17,5,74) apr lbc = ",p_fld(17,5,74) 1160 1223 ! 1161 1224 END SUBROUTINE crs_dom_ope_3d … … 1205 1268 1206 1269 !!---------------------------------------------------------------- 1207 1270 1208 1271 p_fld_crs(:,:) = 0.0 1209 1272 … … 1702 1765 INTEGER :: ijie, ijje, ii, ij, je_2 1703 1766 REAL(wp) :: ze3crs 1704 REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf1767 !REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf 1705 1768 1706 1769 !!---------------------------------------------------------------- … … 1710 1773 1711 1774 1712 CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )1775 !CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf ) 1713 1776 1714 1777 SELECT CASE ( cd_type ) 1715 CASE( 'W' ) 1716 zmask(:,:,1) = p_mask(:,:,1) 1717 DO jk = 2, jpk 1718 zmask(:,:,jk) = p_mask(:,:,jk-1) 1719 ENDDO 1720 CASE DEFAULT 1721 DO jk = 1, jpk 1722 zmask(:,:,jk) = p_mask(:,:,jk) 1723 ENDDO 1778 1779 CASE ('T') 1780 1781 DO jk = 1 , jpk 1782 DO ji = nistr, niend, nn_factx 1783 1784 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1785 IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN !!cc bande du sud style ORCA2 1786 1787 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1788 1789 jj = mje_crs(2) 1790 1791 1792 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk), & 1793 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk), & 1794 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk)) 1795 1796 p_e3_max_crs(ii,2,jk) = ze3crs 1797 1798 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk) + & 1799 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk) + & 1800 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) 1801 1802 1803 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1804 ENDIF 1805 ELSE 1806 jj = mjs_crs(2) 1807 1808 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk), & 1809 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk), & 1810 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk), & 1811 & p_e3(ji ,jj+1,jk) * p_mask(ji ,jj+1,jk), & 1812 & p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk), & 1813 & p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk), & 1814 & p_e3(ji ,jj+2,jk) * p_mask(ji ,jj+2,jk), & 1815 & p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk), & 1816 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 1817 1818 p_e3_max_crs(ii,2,jk) = ze3crs 1819 1820 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk) + & 1821 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk) + & 1822 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) + & 1823 & p_e3(ji ,jj+1,jk) * p_e1(ji ,jj+1) * p_e2(ji ,jj+1) * p_mask(ji ,jj+1,jk) + & 1824 & p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) + & 1825 & p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) + & 1826 & p_e3(ji ,jj+2,jk) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,jk) + & 1827 & p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) + & 1828 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 1829 1830 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1831 ENDIF 1832 1833 DO jj = njstr, njend, nn_facty 1834 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 1835 ij = ( jj - njstr ) * rfacty_r + 3 1836 ijje = mje_crs(ij) 1837 ijie = mie_crs(ii) 1838 ! 1839 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk), & 1840 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk), & 1841 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk), & 1842 & p_e3(ji ,jj+1,jk) * p_mask(ji ,jj+1,jk), & 1843 & p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk), & 1844 & p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk), & 1845 & p_e3(ji ,jj+2,jk) * p_mask(ji ,jj+2,jk), & 1846 & p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk), & 1847 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 1848 1849 p_e3_max_crs(ii,ij,jk) = ze3crs 1850 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk) + & 1851 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk) + & 1852 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) + & 1853 & p_e3(ji ,jj+1,jk) * p_e1(ji ,jj+1) * p_e2(ji ,jj+1) * p_mask(ji ,jj+1,jk) + & 1854 & p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) + & 1855 & p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) + & 1856 & p_e3(ji ,jj+2,jk) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,jk) + & 1857 & p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) + & 1858 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 1859 1860 p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1861 1862 ENDDO 1863 ENDDO 1864 ENDDO 1865 1866 CASE ('U') 1867 1868 DO jk = 1 , jpk 1869 DO ji = nistr, niend, nn_factx 1870 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1871 IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN !!cc bande du sud style ORCA2 1872 1873 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1874 1875 jj = mje_crs(2) 1876 1877 1878 ze3crs = p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk) 1879 1880 p_e3_max_crs(ii,2,jk) = ze3crs 1881 1882 ze3crs = p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) 1883 1884 1885 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1886 ENDIF 1887 ELSE 1888 jj = mjs_crs(2) 1889 1890 ze3crs = MAX( p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk), & 1891 p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk), & 1892 p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 1893 1894 p_e3_max_crs(ii,2,jk) = ze3crs 1895 1896 ze3crs = p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) + & 1897 & p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) + & 1898 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 1899 1900 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1901 ENDIF 1902 DO jj = njstr, njend, nn_facty 1903 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 1904 ij = ( jj - njstr ) * rfacty_r + 3 1905 ijje = mje_crs(ij) 1906 ijie = mie_crs(ii) 1907 ! 1908 ze3crs = MAX( p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk), & 1909 & p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk), & 1910 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 1911 1912 p_e3_max_crs(ii,ij,jk) = ze3crs 1913 1914 ze3crs = p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) + & 1915 & p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) + & 1916 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 1917 1918 p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1919 1920 ENDDO 1921 ENDDO 1922 ENDDO 1923 1924 CASE ('V') 1925 DO jk = 1 , jpk 1926 DO ji = nistr, niend, nn_factx 1927 1928 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1929 IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN !!cc bande du sud style ORCA2 1930 1931 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1932 1933 jj = mje_crs(2) 1934 1935 1936 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk), & 1937 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk), & 1938 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk)) 1939 1940 p_e3_max_crs(ii,2,jk) = ze3crs 1941 1942 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk) + & 1943 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk) + & 1944 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk) 1945 1946 1947 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1948 ENDIF 1949 ELSE 1950 jj = mjs_crs(2) 1951 1952 ze3crs = MAX( p_e3(ji ,jj+2,jk) * p_mask(ji ,jj+2,jk), & 1953 & p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk), & 1954 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 1955 1956 p_e3_max_crs(ii,2,jk) = ze3crs 1957 1958 ze3crs = p_e3(ji ,jj+2,jk) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,jk) + & 1959 & p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) + & 1960 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 1961 1962 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1963 ENDIF 1964 1965 DO jj = njstr, njend, nn_facty 1966 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 1967 ij = ( jj - njstr ) * rfacty_r + 3 1968 ijje = mje_crs(ij) 1969 ijie = mie_crs(ii) 1970 ! 1971 ze3crs = MAX( p_e3(ji ,jj+2,jk) * p_mask(ji ,jj+2,jk), & 1972 & p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk), & 1973 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 1974 1975 p_e3_max_crs(ii,ij,jk) = ze3crs 1976 1977 ze3crs = p_e3(ji ,jj+2,jk) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,jk) + & 1978 & p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) + & 1979 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 1980 1981 p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1982 1983 ENDDO 1984 ENDDO 1985 ENDDO 1986 CASE ('W') 1987 1988 DO jk = 2 , jpk 1989 DO ji = nistr, niend, nn_factx 1990 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1991 IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN !!cc bande du sud style ORCA2 1992 1993 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1994 1995 jj = mje_crs(2) 1996 1997 1998 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk-1), & 1999 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk-1), & 2000 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk-1)) 2001 2002 p_e3_max_crs(ii,2,jk) = ze3crs 2003 2004 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk-1) + & 2005 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk-1) + & 2006 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk-1) 2007 2008 2009 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 2010 ENDIF 2011 ELSE 2012 jj = mjs_crs(2) 2013 2014 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk-1), & 2015 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk-1), & 2016 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk-1), & 2017 & p_e3(ji ,jj+1,jk) * p_mask(ji ,jj+1,jk-1), & 2018 & p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1), & 2019 & p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1), & 2020 & p_e3(ji ,jj+2,jk) * p_mask(ji ,jj+2,jk-1), & 2021 & p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1), & 2022 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 2023 2024 p_e3_max_crs(ii,2,jk) = ze3crs 2025 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk-1) + & 2026 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk-1) + & 2027 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk-1) + & 2028 & p_e3(ji ,jj+1,jk) * p_e1(ji ,jj+1) * p_e2(ji ,jj+1) * p_mask(ji ,jj+1,jk-1) + & 2029 & p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) + & 2030 & p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) + & 2031 & p_e3(ji ,jj+2,jk) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,jk-1) + & 2032 & p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) + & 2033 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 2034 2035 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 2036 ENDIF 2037 2038 2039 DO jj = njstr, njend, nn_facty 2040 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 2041 ij = ( jj - njstr ) * rfacty_r + 3 2042 ijje = mje_crs(ij) 2043 ijie = mie_crs(ii) 2044 ! 2045 ze3crs = MAX( p_e3(ji ,jj ,jk) * p_mask(ji ,jj ,jk-1), & 2046 & p_e3(ji+1,jj ,jk) * p_mask(ji+1,jj ,jk-1), & 2047 & p_e3(ji+2,jj ,jk) * p_mask(ji+2,jj ,jk-1), & 2048 & p_e3(ji ,jj+1,jk) * p_mask(ji ,jj+1,jk-1), & 2049 & p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1), & 2050 & p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1), & 2051 & p_e3(ji ,jj+2,jk) * p_mask(ji ,jj+2,jk-1), & 2052 & p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1), & 2053 & p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 2054 2055 p_e3_max_crs(ii,ij,jk) = ze3crs 2056 2057 ze3crs = p_e3(ji ,jj ,jk) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,jk-1) + & 2058 & p_e3(ji+1,jj ,jk) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,jk-1) + & 2059 & p_e3(ji+2,jj ,jk) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,jk-1) + & 2060 & p_e3(ji ,jj+1,jk) * p_e1(ji ,jj+1) * p_e2(ji ,jj+1) * p_mask(ji ,jj+1,jk-1) + & 2061 & p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) + & 2062 & p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) + & 2063 & p_e3(ji ,jj+2,jk) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,jk-1) + & 2064 & p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) + & 2065 & p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 2066 2067 p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 2068 2069 ENDDO 2070 ENDDO 2071 ENDDO 2072 DO ji = nistr, niend, nn_factx 2073 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2074 IF (nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2)) THEN !!cc bande du sud style ORCA2 2075 2076 IF ( mje_crs(2) - mjs_crs(2) == 1 ) THEN 2077 2078 jj = mje_crs(2) 2079 2080 ze3crs = MAX( p_e3(ji ,jj ,1) * p_mask(ji ,jj ,1), & 2081 & p_e3(ji+1,jj ,1) * p_mask(ji+1,jj ,1), & 2082 & p_e3(ji+2,jj ,1) * p_mask(ji+2,jj ,1)) 2083 2084 p_e3_max_crs(ii,2,1) = ze3crs 2085 2086 ze3crs = p_e3(ji ,jj ,1) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,1) + & 2087 & p_e3(ji+1,jj ,1) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,1) + & 2088 & p_e3(ji+2,jj ,1) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,1) 2089 2090 p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 2091 ENDIF 2092 ELSE 2093 jj = mjs_crs(2) 2094 2095 ze3crs = MAX( p_e3(ji ,jj ,1) * p_mask(ji ,jj ,1), & 2096 & p_e3(ji+1,jj ,1) * p_mask(ji+1,jj ,1), & 2097 & p_e3(ji+2,jj ,1) * p_mask(ji+2,jj ,1), & 2098 & p_e3(ji ,jj+1,1) * p_mask(ji ,jj+1,1), & 2099 & p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1), & 2100 & p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1), & 2101 & p_e3(ji ,jj+2,1) * p_mask(ji ,jj+2,1), & 2102 & p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1), & 2103 & p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 2104 2105 p_e3_max_crs(ii,2,1) = ze3crs 2106 ze3crs = p_e3(ji ,jj ,1) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,1) + & 2107 & p_e3(ji+1,jj ,1) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,1) + & 2108 & p_e3(ji+2,jj ,1) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,1) + & 2109 & p_e3(ji ,jj+1,1) * p_e1(ji ,jj+1) * p_e2(ji ,jj+1) * p_mask(ji ,jj+1,1) + & 2110 & p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) + & 2111 & p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) + & 2112 & p_e3(ji ,jj+2,1) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,1) + & 2113 & p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) + & 2114 & p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 2115 2116 p_e3_crs(ii,2,1) = ze3crs / p_sfc_crs(ii,2,1) 2117 2118 ENDIF 2119 DO jj = njstr, njend, nn_facty 2120 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 2121 ij = ( jj - njstr ) * rfacty_r + 3 2122 ijje = mje_crs(ij) 2123 ijie = mie_crs(ii) 2124 ! 2125 ze3crs = MAX( p_e3(ji ,jj ,1) * p_mask(ji ,jj ,1), & 2126 & p_e3(ji+1,jj ,1) * p_mask(ji+1,jj ,1), & 2127 & p_e3(ji+2,jj ,1) * p_mask(ji+2,jj ,1), & 2128 & p_e3(ji ,jj+1,1) * p_mask(ji ,jj+1,1), & 2129 & p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1), & 2130 & p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1), & 2131 & p_e3(ji ,jj+2,1) * p_mask(ji ,jj+2,1), & 2132 & p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1), & 2133 & p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 2134 2135 p_e3_max_crs(ii,ij,1) = ze3crs 2136 2137 ze3crs = p_e3(ji ,jj ,1) * p_e1(ji ,jj ) * p_e2(ji ,jj ) * p_mask(ji ,jj ,1) + & 2138 & p_e3(ji+1,jj ,1) * p_e1(ji+1,jj ) * p_e2(ji+1,jj ) * p_mask(ji+1,jj ,1) + & 2139 & p_e3(ji+2,jj ,1) * p_e1(ji+2,jj ) * p_e2(ji+2,jj ) * p_mask(ji+2,jj ,1) + & 2140 & p_e3(ji ,jj+1,1) * p_e1(ji ,jj+1) * p_e2(ji ,jj+1) * p_mask(ji ,jj+1,1) + & 2141 & p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) + & 2142 & p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) + & 2143 & p_e3(ji ,jj+2,1) * p_e1(ji ,jj+2) * p_e2(ji ,jj+2) * p_mask(ji ,jj+2,1) + & 2144 & p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) + & 2145 & p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 2146 2147 p_e3_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1) 2148 2149 ENDDO 2150 ENDDO 2151 ! 1724 2152 END SELECT 1725 2153 1726 DO jk = 1, jpk 1727 zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 1728 ENDDO 1729 1730 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1731 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1732 je_2 = mje_crs(2) 1733 DO jk = 1 , jpk 1734 DO ji = nistr, niend, nn_factx 1735 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1736 ze3crs = zsurf(ji ,je_2,jk) * zmask(ji ,je_2,jk) & 1737 & + zsurf(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) & 1738 & + zsurf(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) 1739 1740 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1741 ! 1742 ze3crs = MAX( p_e3(ji ,je_2,jk) * zmask(ji ,je_2,jk), & 1743 & p_e3(ji+1,je_2,jk) * zmask(ji+1,je_2,jk), & 1744 & p_e3(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) ) 1745 ! 1746 p_e3_max_crs(ii,2,jk) = ze3crs 1747 ENDDO 1748 ENDDO 1749 ENDIF 1750 ELSE 1751 je_2 = mjs_crs(2) 1752 DO jk = 1 , jpk 1753 DO ji = nistr, niend, nn_factx 1754 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1755 ze3crs = zsurf(ji ,je_2 ,jk) * zmask(ji ,je_2 ,jk) & 1756 & + zsurf(ji+1,je_2 ,jk) * zmask(ji+1,je_2 ,jk) & 1757 & + zsurf(ji+2,je_2 ,jk) * zmask(ji+2,je_2 ,jk) & 1758 & + zsurf(ji ,je_2+1,jk) * zmask(ji ,je_2+1,jk) & 1759 & + zsurf(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) & 1760 & + zsurf(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) & 1761 & + zsurf(ji ,je_2+2,jk) * zmask(ji ,je_2+2,jk) & 1762 & + zsurf(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) & 1763 & + zsurf(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) 1764 1765 p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 1766 ! 1767 ze3crs = MAX( p_e3(ji ,je_2 ,jk) * zmask(ji ,je_2 ,jk), & 1768 & p_e3(ji+1,je_2 ,jk) * zmask(ji+1,je_2 ,jk), & 1769 & p_e3(ji+2,je_2 ,jk) * zmask(ji+2,je_2 ,jk), & 1770 & p_e3(ji ,je_2+1,jk) * zmask(ji ,je_2+1,jk), & 1771 & p_e3(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk), & 1772 & p_e3(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk), & 1773 & p_e3(ji ,je_2+2,jk) * zmask(ji ,je_2+2,jk), & 1774 & p_e3(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk), & 1775 & p_e3(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) ) 1776 1777 p_e3_max_crs(ii,2,jk) = ze3crs 1778 ENDDO 1779 ENDDO 1780 ENDIF 1781 DO jk = 1 , jpk 1782 DO jj = njstr, njend, nn_facty 1783 DO ji = nistr, niend, nn_factx 1784 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1785 ij = ( jj - njstr ) * rfacty_r + 3 1786 ze3crs = zsurf(ji ,jj ,jk) * zmask(ji ,jj ,jk) & 1787 & + zsurf(ji+1,jj ,jk) * zmask(ji+1,jj ,jk) & 1788 & + zsurf(ji+2,jj ,jk) * zmask(ji+2,jj ,jk) & 1789 & + zsurf(ji ,jj+1,jk) * zmask(ji ,jj+1,jk) & 1790 & + zsurf(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) & 1791 & + zsurf(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) & 1792 & + zsurf(ji ,jj+2,jk) * zmask(ji ,jj+2,jk) & 1793 & + zsurf(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) & 1794 & + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 1795 1796 !cbr 1797 !p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1798 IF( p_sfc_crs(ii,ij,jk) == 0.d0 )WRITE(narea+200,*)"crs_dom_e30 ",ii,ij,jk,p_sfc_crs(ii,ij,jk) ; call flush(narea+200) 1799 IF( p_sfc_crs(ii,ij,jk) .NE. 0.d0 )THEN ; p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1800 ELSE ; p_e3_crs(ii,ij,jk) =0.d0 1801 ENDIF 1802 ! 1803 ze3crs = MAX( p_e3(ji ,jj ,jk) * zmask(ji ,jj ,jk), & 1804 & p_e3(ji+1,jj ,jk) * zmask(ji+1,jj ,jk), & 1805 & p_e3(ji+2,jj ,jk) * zmask(ji+2,jj ,jk), & 1806 & p_e3(ji ,jj+1,jk) * zmask(ji ,jj+1,jk), & 1807 & p_e3(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk), & 1808 & p_e3(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk), & 1809 & p_e3(ji ,jj+2,jk) * zmask(ji ,jj+2,jk), & 1810 & p_e3(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk), & 1811 & p_e3(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) ) 1812 1813 p_e3_max_crs(ii,ij,jk) = ze3crs 1814 ENDDO 1815 ENDDO 1816 ENDDO 1817 1818 CALL crs_lbc_lnk( p_e3_crs , cd_type, 1.0, pval=1.0 ) 1819 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 2154 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 ) 2155 CALL crs_lbc_lnk( p_e3_crs , cd_type, 1.0, pval=1.0 ) 1820 2156 ! 1821 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )2157 !CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask ) 1822 2158 ! 1823 2159 END SUBROUTINE crs_dom_e3 … … 1836 2172 INTEGER :: ji, jj, jk ! dummy loop indices 1837 2173 INTEGER :: ii, ij, je_2 2174 INTEGER :: iji,ijj 1838 2175 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk 1839 2176 !!---------------------------------------------------------------- 1840 2177 ! Initialize 1841 2178 p_surf_crs(:,:,:)=0._wp 2179 p_surf_crs_msk(:,:,:)=0._wp 1842 2180 1843 2181 CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) … … 1849 2187 zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) 1850 2188 ENDDO 1851 zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 1852 DO jk = 2, jpk 1853 zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 2189 !zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 2190 !cbr DO jk = 2, jpk 2191 DO jk = 1, jpk 2192 !cbr zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 2193 zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 1854 2194 ENDDO 1855 2195 … … 1878 2218 ENDDO 1879 2219 END SELECT 2220 2221 WRITE(narea+200,*)"TOTO",nldj_crs,mjs_crs(1), mje_crs(1),mjs_crs(2), mje_crs(2),mjs_crs(3), mje_crs(3),mjs_crs(4), mje_crs(4) ; CALL FLUSH(narea+200) 2222 2223 SELECT CASE ( cd_type ) 2224 2225 CASE ('W') 1880 2226 1881 2227 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 … … 1916 2262 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1917 2263 ij = ( jj - njstr ) * rfacty_r + 3 1918 IF( jk==1 .AND. ii==2 .AND. ij==18 )THEN1919 WRITE(narea+200,*)"crs_dom_sfc ",zsurf(ji,jj ,jk) , zsurf(ji+1,jj ,jk) , zsurf(ji+2,jj ,jk) &1920 & , zsurf(ji,jj+1,jk) , zsurf(ji+1,jj+1,jk) , zsurf(ji+2,jj+1,jk) &1921 & , zsurf(ji,jj+2,jk) , zsurf(ji+1,jj+2,jk) , zsurf(ji+2,jj+2,jk)1922 call flush(narea+200)1923 ENDIF1924 2264 ! 1925 2265 p_surf_crs (ii,ij,jk) = zsurf(ji,jj ,jk) + zsurf(ji+1,jj ,jk) + zsurf(ji+2,jj ,jk) & 1926 2266 & + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 1927 2267 & + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 1928 IF( jk==1 .AND. ii==2 .AND. ij==18 )WRITE(narea+200,*)"crs_dom_sfc ",p_surf_crs (ii,ij,jk) ; call flush(narea+200)1929 2268 p_surf_crs_msk(ii,ij,jk) = zsurfmsk(ji,jj ,jk) + zsurfmsk(ji+1,jj ,jk) + zsurfmsk(ji+2,jj ,jk) & 1930 2269 & + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk) & 1931 2270 & + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk) 2271 2272 !cbr 2273 iji=117 ; ijj=211 2274 iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 2275 IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 2276 WRITE(narea+5000,*)"SFC W =======> " 2277 WRITE(narea+5000,*)ii,ij,jk 2278 WRITE(narea+5000,*)ji,jj 2279 WRITE(narea+5000,*)zsurfmsk(ji,jj ,jk) , zsurfmsk(ji+1,jj ,jk) , zsurfmsk(ji+2,jj ,jk) 2280 WRITE(narea+5000,*)zsurfmsk(ji,jj+1,jk) , zsurfmsk(ji+1,jj+1,jk) , zsurfmsk(ji+2,jj+1,jk) 2281 WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk) , zsurfmsk(ji+1,jj+2,jk) , zsurfmsk(ji+2,jj+2,jk) 2282 WRITE(narea+5000,*) p_surf_crs (ii,ij,jk), p_surf_crs_msk(ii,ij,jk) 2283 ENDIF 2284 2285 1932 2286 ENDDO 1933 2287 ENDDO 1934 2288 ENDDO 1935 WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs (2,18,1) 2289 2290 CASE ('U') 2291 2292 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 2293 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 2294 je_2 = mje_crs(2) 2295 DO jk = 1, jpk 2296 DO ji = nistr, niend, nn_factx 2297 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2298 ! 2299 p_surf_crs (ii,2,jk) = zsurf(ji+2,je_2 ,jk) 2300 ! 2301 p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji+2,je_2,jk) 2302 ! 2303 ENDDO 2304 ENDDO 2305 ENDIF 2306 ELSE 2307 je_2 = mjs_crs(2) 2308 DO jk = 1, jpk 2309 DO ji = nistr, niend, nn_factx 2310 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2311 ! 2312 p_surf_crs (ii,2,jk) = zsurf(ji+2,je_2 ,jk) & 2313 & + zsurf(ji+2,je_2+1,jk) & 2314 & + zsurf(ji+2,je_2+2,jk) 2315 2316 p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji+2,je_2 ,jk) & 2317 & + zsurfmsk(ji+2,je_2+1,jk) & 2318 & + zsurfmsk(ji+2,je_2+2,jk) 2319 ENDDO 2320 ENDDO 2321 ENDIF 2322 2323 DO jk = 1, jpk 2324 DO jj = njstr, njend, nn_facty 2325 DO ji = nistr, niend, nn_factx 2326 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2327 ij = ( jj - njstr ) * rfacty_r + 3 2328 ! 2329 p_surf_crs (ii,ij,jk) = zsurf(ji+2,jj ,jk) & 2330 & + zsurf(ji+2,jj+1,jk) & 2331 & + zsurf(ji+2,jj+2,jk) 2332 p_surf_crs_msk(ii,ij,jk) = zsurfmsk(ji+2,jj ,jk) & 2333 & + zsurfmsk(ji+2,jj+1,jk) & 2334 & + zsurfmsk(ji+2,jj+2,jk) 2335 !cbr 2336 !iji=117 ; ijj=211 2337 !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 2338 !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 2339 !WRITE(narea+5000,*)"SFC U =======> " 2340 !WRITE(narea+5000,*)ii,ij,jk 2341 !WRITE(narea+5000,*)ji,jj 2342 !WRITE(narea+5000,*)mis_crs(2),rfactx_r , ( ji - 1 - mis_crs(2) ) * rfactx_r 2343 !WRITE(narea+5000,*)zsurf(ji+2,jj ,jk),zsurf(ji+2,jj+1,jk),zsurf(ji+2,jj+2,jk) 2344 !WRITE(narea+5000,*)zsurfmsk(ji+2,jj ,jk),zsurfmsk(ji+2,jj+1,jk),zsurfmsk(ji+2,jj+2,jk) 2345 !WRITE(narea+5000,*)p_surf_crs (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 2346 !ENDIF 2347 !iji=116 ; ijj=211 2348 !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 2349 !IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 2350 !WRITE(narea+5000,*)"SFC U =======> " 2351 !WRITE(narea+5000,*)ii,ij,jk 2352 !WRITE(narea+5000,*)ji,jj 2353 !WRITE(narea+5000,*)zsurf(ji+2,jj ,jk),zsurf(ji+2,jj+1,jk),zsurf(ji+2,jj+2,jk) 2354 !WRITE(narea+5000,*)zsurfmsk(ji+2,jj ,jk),zsurfmsk(ji+2,jj+1,jk),zsurfmsk(ji+2,jj+2,jk) 2355 !WRITE(narea+5000,*)p_surf_crs (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 2356 !ENDIF 2357 ENDDO 2358 ENDDO 2359 ENDDO 2360 2361 CASE ('V') 2362 2363 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 2364 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 2365 je_2 = mje_crs(2) 2366 DO jk = 1, jpk 2367 DO ji = nistr, niend, nn_factx 2368 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2369 ! 2370 p_surf_crs (ii,2,jk) = zsurf(ji,je_2 ,jk) + zsurf(ji+1,je_2 ,jk) + zsurf(ji+2,je_2 ,jk) 2371 ! 2372 p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk) 2373 ! 2374 ENDDO 2375 ENDDO 2376 ENDIF 2377 ELSE 2378 je_2 = mjs_crs(2) 2379 DO jk = 1, jpk 2380 DO ji = nistr, niend, nn_factx 2381 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2382 ! 2383 p_surf_crs (ii,2,jk) = zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 2384 p_surf_crs_msk(ii,2,jk) = zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk) 2385 ENDDO 2386 ENDDO 2387 ENDIF 2388 2389 DO jk = 1, jpk 2390 DO jj = njstr, njend, nn_facty 2391 DO ji = nistr, niend, nn_factx 2392 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 2393 ij = ( jj - njstr ) * rfacty_r + 3 2394 ! 2395 p_surf_crs (ii,ij,jk) = zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 2396 p_surf_crs_msk(ii,ij,jk) = zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk) 2397 iji=117 ; ijj=210 2398 iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 2399 IF( ii==iji .AND. ij==ijj .AND. jk==74 )THEN 2400 WRITE(narea+5000,*)"SFC V =======> " 2401 WRITE(narea+5000,*)ii,ij,jk 2402 WRITE(narea+5000,*)ji,jj 2403 WRITE(narea+5000,*)zsurfmsk(ji,jj+2,jk),zsurfmsk(ji+1,jj+2,jk),zsurfmsk(ji+2,jj+2,jk) 2404 WRITE(narea+5000,*)p_surf_crs (ii,ij,jk),p_surf_crs_msk(ii,ij,jk) 2405 ENDIF 2406 ENDDO 2407 ENDDO 2408 ENDDO 2409 2410 END SELECT 2411 DO jk=1,jpk 2412 DO ji=1,jpi_crs 2413 DO jj=1,jpj_crs 2414 IF( p_surf_crs_msk(ji,jj,jk) .NE. p_surf_crs_msk(ji,jj,jk) )WRITE(narea+200,*)"SFC 4 ",ji,jj,jk,p_surf_crs_msk(ji,jj,jk) ; call flush(narea+200) 2415 ENDDO 2416 ENDDO 2417 ENDDO 1936 2418 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0, pval=1.0 ) 1937 2419 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 1938 WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs (2,18,1)1939 2420 1940 2421 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5010 r5105 66 66 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 67 67 REAL(wp) :: z2dcrsu, z2dcrsv 68 REAL(wp) :: zmin,zmax 69 INTEGER :: i,j,ijis,ijie,ijjs,ijje 70 REAL(wp) :: zw,zwp1,zum1,zu,zvm1,zv,zsnm,zsm,z 71 INTEGER :: iji,ijj 68 72 !! 69 73 !!---------------------------------------------------------------------- 70 74 ! 75 !IF(narea==267)WRITE(narea+5000,*)"========================================> crsfldt ",kt 71 76 72 77 IF( nn_timing == 1 ) CALL timing_start('crs_fld') … … 91 96 wn_crs (:,:,: ) = 0._wp ! w 92 97 avt_crs (:,:,: ) = 0._wp ! avt 98 hdivb_crs(:,:,: ) = 0._wp ! hdiv 93 99 hdivn_crs(:,:,: ) = 0._wp ! hdiv 94 100 rke_crs (:,:,: ) = 0._wp ! rke … … 110 116 111 117 ! Temperature 118 zt(:,:,:) = tsb(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp 119 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 120 tsb_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 112 121 zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp 113 122 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) … … 119 128 120 129 ! Salinity 130 zs(:,:,:) = tsb(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 131 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 132 tsb_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 121 133 zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 122 134 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) … … 127 139 128 140 ! U-velocity 141 CALL crs_dom_ope( ub, 'SUM', 'U', umask, ub_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 129 142 CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 143 !cbr 144 ub_crs(:,:,:) = ub_crs(:,:,:)*umask_crs(:,:,:) 145 un_crs(:,:,:) = un_crs(:,:,:)*umask_crs(:,:,:) 130 146 ! 131 147 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 146 162 147 163 ! V-velocity 164 !IF(narea==267)WRITE(narea+5000,*)"deg vb_crs" 165 CALL crs_dom_ope( vb, 'SUM', 'V', vmask, vb_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 166 !IF(narea==267)WRITE(narea+5000,*)"deg vn_crs" 148 167 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 168 !IF(narea==267)WRITE(narea+5000,*)"1 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74) 169 vb_crs(:,:,:) = vb_crs(:,:,:)*vmask_crs(:,:,:) 170 vn_crs(:,:,:) = vn_crs(:,:,:)*vmask_crs(:,:,:) 171 !IF(narea==267)WRITE(narea+5000,*)"2 vn_crs(17,5,74) = ",vn_crs(17,5,74),vmask_crs(17,5,74),vn(46,13,74),vn(47,13,74),vn(48,13,74) 149 172 ! 150 173 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 174 197 DO jj = 2, jpj_crsm1 175 198 IF( tmask_crs(ji,jj,jk ) > 0 ) THEN 199 !z2dcrsu = ( un_crs(ji ,jj ,jk) * crs_surfu_wgt(ji ,jj ,jk) ) & 200 ! & - ( un_crs(ji-1,jj ,jk) * crs_surfu_wgt(ji-1,jj ,jk) ) 201 !z2dcrsv = ( vn_crs(ji ,jj ,jk) * crs_surfv_wgt(ji ,jj ,jk) ) & 202 ! & - ( vn_crs(ji ,jj-1,jk) * crs_surfv_wgt(ji ,jj-1,jk) ) 203 ! 204 !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 176 205 z2dcrsu = ( un_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & 177 206 & - ( un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) … … 179 208 & - ( vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) 180 209 ! 181 IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / ocean_volume_crs_t(ji,jj,jk) 210 !cbr 211 ! 212 !bug1: il manquait le facvol_t(ji,jj,jk) ds la division ; ca creait des grosses erreurs de Wcrs ( vu en recalculant la divergence 3D ) 213 !bug2: mm test que bug1: on n'obtient tjs pas zero 214 !on a la div calculée via ocean_volume_crs_t puis w via e3t_crs ; or ,e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) NE ocean_volume_crs_t*crs_volt_wgt(ji,jj,jk) 215 !exp (117,211,74) : e1*e2*e3=235206030060.005 / ocean_volume_crs_t * facvol = 235205585307.810 216 ! e1*e2*e3-cean_volume_crs_t * facvol/(cean_volume_crs_t * facvol) ~1.e-6) 217 !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk)) 218 !IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk)) 219 IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) 220 221 !iji=117 ; ijj=211 222 !iji=iji-nimpp_crs+1 ; ijj=ijj-njmpp_crs+1 223 !IF( ji==iji .AND. jj==ijj )THEN 224 !WRITE(narea+5000,*)"hdivn_crs =======> " 225 !WRITE(narea+5000,*) "u" ,jk,un_crs(ji ,jj ,jk) ,e2e3u_msk(ji ,jj ,jk),un_crs(ji ,jj ,jk)*e2e3u_msk(ji ,jj ,jk) 226 !WRITE(narea+5000,*) "um1",jk,un_crs(ji-1,jj ,jk) , e2e3u_msk(ji-1,jj ,jk),un_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) 227 !WRITE(narea+5000,*) "v",jk,vn_crs(ji ,jj ,jk) , e1e3v_msk(ji ,jj ,jk),vn_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) 228 !WRITE(narea+5000,*) "vm1",jk,vn_crs(ji ,jj-1,jk) , e1e3v_msk(ji ,jj-1,jk),vn_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) 229 !WRITE(narea+5000,*) "t1 ",jk,z2dcrsu,z2dcrsv, z2dcrsu + z2dcrsv,hdivn_crs(ji,jj,jk) 230 !WRITE(narea+5000,*) "t2 ",jk,e1t_crs(ji,jj),e2t_crs(ji,jj),e3t_crs(ji,jj,jk),e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk) 231 !WRITE(narea+5000,*) "t3 ",jk,ocean_volume_crs_t(ji,jj,jk),facvol_t(ji,jj,jk),facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) 232 !WRITE(narea+5000,*) "t4 ",jk, ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk)) 233 !WRITE(narea+5000,*) "t5 ",jk, ( z2dcrsu + z2dcrsv ) / (e1t_crs(ji,jj)*e2t_crs(ji,jj)*e3t_crs(ji,jj,jk)) 234 !ENDIF 235 236 237 !IF( crs_volt_wgt(ji,jj,jk) .NE. 0._wp ) hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 238 z2dcrsu = ( ub_crs(ji ,jj ,jk) * e2e3u_msk(ji ,jj ,jk) ) & 239 & - ( ub_crs(ji-1,jj ,jk) * e2e3u_msk(ji-1,jj ,jk) ) 240 z2dcrsv = ( vb_crs(ji ,jj ,jk) * e1e3v_msk(ji ,jj ,jk) ) & 241 & - ( vb_crs(ji ,jj-1,jk) * e1e3v_msk(ji ,jj-1,jk) ) 242 ! 243 IF( ocean_volume_crs_t(ji,jj,jk) .NE. 0._wp ) hdivb_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / (facvol_t(ji,jj,jk)*ocean_volume_crs_t(ji,jj,jk) ) 182 244 ENDIF 183 245 ENDDO … … 189 251 190 252 253 ! DO jk = 1, jpkm1 ! Interior value 254 ! DO jj = 1, jpj_crs 255 ! DO ji = 1, jpi_crs 256 ! IF( e3t_crs(ji,jj,jk) .NE. e3t_crs(ji,jj,jk) )WRITE(narea+200,*)"e3t_crs",e3t_crs(ji,jj,jk) ; call flush(narea+200) 257 ! IF( hdivn_crs(ji,jj,jk) .NE. hdivn_crs(ji,jj,jk) )WRITE(narea+200,*)"hdivn_crs",hdivn_crs(ji,jj,jk) ; call flush(narea+200) 258 ! END DO 259 ! END DO 260 ! END DO 261 191 262 ! W-velocity 192 263 IF( ln_crs_wn ) THEN 193 264 CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 194 ! CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w )195 265 ELSE 196 266 wn_crs(:,:,jpk) = 0._wp 197 267 DO jk = jpkm1, 1, -1 198 wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk) 268 !cbr wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk) 269 wn_crs(:,:,jk) = e1e2w_msk(:,:,jk+1)*wn_crs(:,:,jk+1) - hdivn_crs(:,:,jk) 270 WHERE( e1e2w_msk(:,:,jk) .NE. 0._wp ) wn_crs(:,:,jk) = wn_crs(:,:,jk) /e1e2w_msk(:,:,jk) 199 271 ENDDO 200 272 ENDIF 273 201 274 CALL iom_put( "woce", wn_crs ) ! vertical velocity 202 275 ! free memory … … 216 289 ! sbc fields 217 290 291 CALL crs_dom_ope( sshb , 'VOL', 'T', tmask, sshb_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) 218 292 CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) 293 CALL crs_dom_ope( ssha , 'VOL', 'T', tmask, ssha_crs , p_e12=e1e2t, p_e3=zfse3t , psgn=1.0 ) 219 294 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) 220 295 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 ) … … 224 299 CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 225 300 CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 301 CALL crs_dom_ope( fmmflx,'SUM', 'T', tmask, fmmflx_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 226 302 CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 227 303 CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) … … 237 313 CALL iom_put( "ice_cover", fr_i_crs ) ! ice cover output 238 314 315 !cbr 316 !IF(narea==267)WRITE(narea+5000,*)"vn_crs(17,5,74) = ",vn_crs(17,5,74) 317 !ji=117 ; jj=211 ; jk=74 318 !ji=ji-nimpp_crs+1 ; jj=jj-njmpp_crs+1 319 !IF( ji .GE. 2 .AND. ji .LE. jpi_crs-1 .AND. jj .GE. 2 .AND. jj .LE. jpj_crs-1 )THEN 320 !WRITE(narea+5000,*)"=======> kt ",kt 321 !WRITE(narea+5000,*)ji,jj,glamt(ji,jj),gphit(ji,jj) 322 !WRITE(narea+5000,*)"um1 crs ",umask_crs(ji-1,jj,jk),e2e3u_msk(ji-1,jj,jk),un_crs(ji-1,jj,jk),umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk) 323 !WRITE(narea+5000,*)"u crs ",umask_crs(ji,jj,jk),e2e3u_msk(ji,jj,jk),un_crs(ji,jj,jk),umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk) 324 !WRITE(narea+5000,*)"vm1 crs ",vmask_crs(ji,jj-1,jk),e1e3v_msk(ji,jj-1,jk),vn_crs(ji,jj-1,jk),vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk) 325 !WRITE(narea+5000,*)"v crs ",vmask_crs(ji,jj,jk),e1e3v_msk(ji,jj,jk),vn_crs(ji,jj,jk),vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk) 326 !WRITE(narea+5000,*)"wp1 crs ",tmask_crs(ji,jj,jk+1),e1e2w_msk(ji,jj,jk+1),wn_crs(ji,jj,jk+1),tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1) 327 !WRITE(narea+5000,*)"w crs ",tmask_crs(ji,jj,jk),e1e2w_msk(ji,jj,jk),wn_crs(ji,jj,jk),tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk) 328 !z = umask_crs(ji,jj,jk)*e2e3u_msk(ji,jj,jk)*un_crs(ji,jj,jk) - umask_crs(ji-1,jj,jk)*e2e3u_msk(ji-1,jj,jk)*un_crs(ji-1,jj,jk) + & 329 ! vmask_crs(ji,jj,jk)*e1e3v_msk(ji,jj,jk)*vn_crs(ji,jj,jk) - vmask_crs(ji,jj-1,jk)*e1e3v_msk(ji,jj-1,jk)*vn_crs(ji,jj-1,jk) + & 330 ! tmask_crs(ji,jj,jk)*e1e2w_msk(ji,jj,jk)*wn_crs(ji,jj,jk) - tmask_crs(ji,jj,jk+1)*e1e2w_msk(ji,jj,jk+1)*wn_crs(ji,jj,jk+1) 331 !WRITE(narea+5000,*)"sum ",z 332 !ijie = mie_crs(ji) 333 !ijis = mis_crs(ji) 334 !ijje = mje_crs(jj) 335 !ijjs = mjs_crs(jj) 336 !DO i=ijis,ijie 337 ! DO j=ijjs,ijje 338 ! WRITE(narea+5000,*)"tmask",i,j,tmask(i,j,jk) 339 ! ENDDO 340 !ENDDO 341 342 !z=0._wp 343 !zsm=0._wp 344 !DO i=ijis,ijie 345 ! DO j=ijjs,ijje 346 ! WRITE(narea+5000,*)"w",i,j,tmask(i,j,jk),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk) 347 ! z=z+tmask(i,j,jk)*e1t(i,j)*e2t(i,j)*wn(i,j,jk) 348 ! zsm=zsm+tmask(i,j,jk)*e1t(i,j)*e2t(i,j) 349 ! ENDDO 350 !ENDDO 351 352 !zw=z 353 !WRITE(narea+5000,*)"w sum ",zsm,zw 354 !z=0._wp 355 !zsm=0._wp 356 !DO i=ijis,ijie 357 ! DO j=ijjs,ijje 358 ! WRITE(narea+5000,*)"wp1 ",i,j,tmask(i,j,jk+1),e1t(i,j),e2t(i,j),e1t(i,j)*e2t(i,j),wn(i,j,jk+1) 359 ! z=z+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j)*wn(i,j,jk+1) 360 ! zsm=zsm+tmask(i,j,jk+1)*e1t(i,j)*e2t(i,j) 361 ! ENDDO 362 !ENDDO 363 !zwp1=z 364 !WRITE(narea+5000,*)"wp1 sum ",zsm,zwp1 365 !z=0._wp 366 !zsm=0._wp 367 !i=ijis-1 368 !DO j=ijjs,ijje 369 ! WRITE(narea+5000,*)"um1",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk) 370 ! z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk) 371 ! zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) 372 !ENDDO 373 !zum1=z 374 !WRITE(narea+5000,*)"um1 sum ",zsm,zum1 375 !z=0._wp 376 !zsm=0._wp 377 !i=ijie 378 !DO j=ijjs,ijje 379 ! WRITE(narea+5000,*)"u",i,j,umask(i,j,jk),e2u(i,j),e3u_0(i,j,jk),e2u(i,j)*e3u_0(i,j,jk),un(i,j,jk) 380 ! z=z+e2u(i,j)*e3u_0(i,j,jk)*un(i,j,jk) 381 ! zsm=zsm+e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) 382 !ENDDO 383 !zu=z 384 !WRITE(narea+5000,*)"u sum ",zsm,zu 385 !z=0._wp 386 !zsm=0._wp 387 !j=ijjs-1 388 !DO i=ijis,ijie 389 ! WRITE(narea+5000,*)"vm1",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk) 390 ! z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk) 391 ! zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) 392 !ENDDO 393 !zvm1=z 394 !WRITE(narea+5000,*)"vm1 sum ",zsm,zvm1 395 !z=0._wp 396 !zsm=0._wp 397 !j=ijje 398 !DO i=ijis,ijie 399 ! WRITE(narea+5000,*)"v",i,j,vmask(i,j,jk),e1v(i,j),e3v_0(i,j,jk),e1v(i,j)*e3v_0(i,j,jk),vn(i,j,jk) 400 ! z=z+e1v(i,j)*e3v_0(i,j,jk)*vn(i,j,jk) 401 ! zsm=zsm+e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) 402 !ENDDO 403 !zv=z 404 !WRITE(narea+5000,*)"v sum ",zv 405 !WRITE(narea+5000,*)"sum ",zw+zwp1+zum1+zu+zvm1+zv 406 !DO i=ijis,ijie 407 ! DO j=ijjs,ijje 408 ! WRITE(narea+5000,*)"msk",i,j,tmask(i,j,jk),umask(i,j,jk),vmask(i,j,jk) 409 ! WRITE(narea+5000,*)"vel",i,j,un(i,j,jk),vn(i,j,jk),wn(i,j,jk) 410 ! ENDDO 411 !ENDDO 412 413 !DO i=ijis,ijie 414 ! DO j=ijjs,ijje 415 ! z = un(i,j,jk)*e2u(i,j)*e3u_0(i,j,jk)*umask(i,j,jk) - un(i-1,j,jk)*e2u(i-1,j)*e3u_0(i-1,j,jk)*umask(i-1,j,jk) + & 416 ! vn(i,j,jk)*e1v(i,j)*e3v_0(i,j,jk)*vmask(i,j,jk) - vn(i,j-1,jk)*e1v(i,j-1)*e3v_0(i,j-1,jk)*vmask(i,j-1,jk) + & 417 ! wn(i,j,jk)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk) - wn(i,j,jk+1)*e2t(i,j)*e1t(i,j)*tmask(i,j,jk+1) 418 ! WRITE(narea+5000,*)"div ",i,j,jk,z 419 ! ENDDO 420 !ENDDO 421 422 !ENDIF 423 424 425 239 426 ! free memory 240 427 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w ) -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r5007 r5105 68 68 INTEGER :: ierr ! allocation error status 69 69 INTEGER :: ios ! Local integer output status for namelist read 70 REAL(wp) :: zmin,zmax 70 71 REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w 71 72 72 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn 73 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn, ln_crs_top 73 74 !!---------------------------------------------------------------------- 74 75 ! … … 160 161 CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs ) 161 162 163 WHERE(e1t_crs == 0._wp) e1t_crs=r_inf 164 WHERE(e1u_crs == 0._wp) e1u_crs=r_inf 165 WHERE(e1v_crs == 0._wp) e1v_crs=r_inf 166 WHERE(e1f_crs == 0._wp) e1f_crs=r_inf 167 WHERE(e2t_crs == 0._wp) e2t_crs=r_inf 168 WHERE(e2u_crs == 0._wp) e2u_crs=r_inf 169 WHERE(e2v_crs == 0._wp) e2v_crs=r_inf 170 WHERE(e2f_crs == 0._wp) e2f_crs=r_inf 171 162 172 e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:) 163 173 … … 169 179 CASE ( 0, 1, 4 ) ! mesh on the sphere 170 180 181 zmin=MINVAL(ABS(gphif_crs(:,:)));zmax=MAXVAL(ABS(gphif_crs(:,:)));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"gphif_crs",zmin,zmax 171 182 ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) ) 172 183 … … 190 201 191 202 ! 3.d.2 Surfaces 203 e2e3u_crs(:,:,:)=0._wp 204 e2e3u_msk(:,:,:)=0._wp 205 e1e3v_crs(:,:,:)=0._wp 206 e1e3v_msk(:,:,:)=0._wp 192 207 CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t ) 193 208 WRITE(narea+200,*)"e1e2w_crs(2,18,1) ",e1e2w_crs(2,18,1) … … 207 222 208 223 facsurfu(ji,jj,jk) = umask_crs(ji,jj,jk) * e2e3u_msk(ji,jj,jk) 209 IF( e2e3u_crs(ji,jj,jk) .NE. 0._wp ) facsurfu(ji,jj,jk) = facsurfu(ji,jj,jk) / e2e3u_crs(ji,jj,jk) 224 225 IF( facsurfu(ji,jj,jk) .NE. facsurfu(ji,jj,jk) )WRITE(narea+200,*)'BUG1',facsurfu(ji,jj,jk);call flush(narea+200) 226 IF( e2e3u_crs(ji,jj,jk) .NE. e2e3u_crs(ji,jj,jk) ) WRITE(narea+200,*)'BUG2',e2e3u_crs(ji,jj,jk);call flush(narea+200) 227 IF( e2e3u_msk(ji,jj,jk) .NE. e2e3u_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG3',e2e3u_msk(ji,jj,jk) ;call flush(narea+200) 228 IF( e1e2w_msk(ji,jj,jk) .NE. e1e2w_msk(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',ji,jj,jk,e1e2w_msk(ji,jj,jk) ;call flush(narea+200) 229 IF( tmask(ji,jj,jk) .NE. tmask(ji,jj,jk) ) WRITE(narea+200,*)'BUG4',tmask(ji,jj,jk) ;call flush(narea+200) 230 IF( e1t(ji,jj) .NE. e1t(ji,jj) ) WRITE(narea+200,*)'BUG5',e1t(ji,jj) ;call flush(narea+200) 231 IF( e1t(ji,jj) .NE. e2t(ji,jj) ) WRITE(narea+200,*)'BUG6',e2t(ji,jj) ;call flush(narea+200) 210 232 211 233 facsurfv(ji,jj,jk) = vmask_crs(ji,jj,jk) * e1e3v_msk(ji,jj,jk) … … 224 246 CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 225 247 CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 248 WHERE(e3t_max_crs == 0._wp) e3t_max_crs=r_inf 249 WHERE(e3u_max_crs == 0._wp) e3u_max_crs=r_inf 250 WHERE(e3v_max_crs == 0._wp) e3v_max_crs=r_inf 251 WHERE(e3w_max_crs == 0._wp) e3w_max_crs=r_inf 226 252 227 253 ! Reset 0 to e3t_0 or e3w_0 … … 264 290 CALL dom_grid_glo ! Return to parent grid domain 265 291 ENDIF 266 292 293 294 rhop_crs(:,:,:)=0._wp ; rhd_crs(:,:,:)=0._wp ; rb2_crs(:,:,:)=0._wp 295 296 267 297 !--------------------------------------------------------- 268 298 ! 7. Finish and clean-up -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r4990 r5105 149 149 ! ! (mi0=1 and mi1=0 if the global index is not in the local domain) 150 150 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimppt, njmppt !: i-, j-indexes for each processor 151 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimpptea, njmpptno !: i-, j-indexes for each processor's northern and eastern neighbour 151 152 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ibonit, ibonjt !: i-, j- processor neighbour existence 152 153 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nlcit , nlcjt !: dimensions of every subdomain 154 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nlcitea !: dimensions of every subdomain eastern neighbour 153 155 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nldit , nldjt !: first, last indoor index for each i-domain 154 156 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nleit , nlejt !: first, last indoor index for each j-domain … … 337 339 ! 338 340 ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj), & 339 & nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 341 & nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), & 342 & njmpptno(jpnij), nimpptea(jpnij), nlcitea(jpnij), STAT=ierr(1) ) 340 343 ! 341 344 ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , & -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5003 r5105 18 18 !! iom_rstput : write a field in a restart file (interfaced to several routines) 19 19 !!-------------------------------------------------------------------- 20 USE dom_oce ! ocean space and time domain 20 USE dom_oce, ONLY : nimpp, njmpp, nlci, nlcj, nldi, nldj, nlei, nlej, & 21 mig, mjg, narea, & 22 gphiv, gphif, & 23 agrif_root, agrif_cfixed, lk_agrif, & 24 rdt,rdttra, gdept_0, ln_crs, gdepw_0, adatrj, fjulday 25 21 26 USE c1d ! 1D vertical configuration 22 27 USE flo_oce ! floats module declarations -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4990 r5105 409 409 CALL ldf_dyn_init ! Lateral ocean momentum physics 410 410 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 411 411 ! 412 IF( ln_crs .AND. lk_ldfslp ) THEN 413 CALL dom_grid_crs 414 CALL ldf_slp_init_crs 415 CALL dom_grid_glo 416 ENDIF 412 417 ! ! Active tracers 413 418 CALL tra_qsr_init ! penetrative solar radiation qsr 414 419 CALL tra_bbc_init ! bottom heat flux 415 420 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 421 ! 422 IF( ln_crs .AND. lk_trabbl ) THEN 423 CALL dom_grid_crs 424 CALL tra_bbl_init_crs ! advective (and/or diffusive) bottom boundary layer scheme 425 CALL dom_grid_glo 426 ENDIF 427 ! 416 428 CALL tra_dmp_init ! internal damping trends- tracers 417 429 CALL tra_adv_init ! horizontal & vertical advection … … 434 446 #if defined key_top 435 447 ! ! Passive tracers 448 IF( ln_crs_top ) CALL dom_grid_crs 436 449 CALL trc_init 450 IF( ln_crs_top ) CALL dom_grid_glo 437 451 #endif 438 452 ! ! Diagnostics -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90
r4990 r5105 33 33 USE step_oce ! time stepping definition modules 34 34 USE iom 35 USE crs 35 36 36 37 IMPLICIT NONE … … 138 139 CALL zdf_mxl( kstp ) ! mixed layer depth 139 140 141 IF(ln_crs) CALL zdf_mxl_crs(kstp) 140 142 ! write TKE or GLS information in the restart file 141 143 IF( lrst_oce .AND. lk_zdftke ) CALL tke_rst( kstp, 'WRITE' ) … … 224 226 ! Passive Tracer Model 225 227 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 228 IF( ln_crs ) THEN 229 CALL dom_grid_crs 230 CALL eos_crs(tsb_crs , rhd_crs, rhop_crs) 231 CALL bn2_crs(tsb_crs , rb2_crs) 232 IF( ln_zps ) CALL zps_hde_crs( kstp, 2, tsb_crs, gtsu_crs, gtsv_crs, rhd_crs, gru_crs, grv_crs ) 233 CALL zdf_mxl_crs(kstp) 234 IF( lk_ldfslp .AND. .NOT. ln_traldf_grif ) & 235 CALL ldf_slp_crs( kstp, rhd_crs, rb2_crs ) 236 CALL dom_grid_glo 237 ENDIF 238 239 IF( ln_crs_top ) CALL dom_grid_crs 240 226 241 CALL trc_stp( kstp ) ! time-stepping 242 243 IF( ln_crs_top ) CALL dom_grid_glo 227 244 #endif 228 245 -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4990 r5105 95 95 96 96 USE crsfld ! Standard output on coarse grid (crs_fld routine) 97 USE zdfmxl_crs 98 USE eosbn2_crs 99 USE zpshde_crs 100 USE ldfslp_crs 97 101 98 102 USE asminc ! assimilation increments (tra_asm_inc routine) -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r4996 r5105 13 13 !!---------------------------------------------------------------------- 14 14 USE trc ! passive tracers common variables 15 USE iom ! I/O manager 15 USE oce_trc 16 USE crs, ONLY : ln_crs 16 17 17 18 IMPLICIT NONE … … 32 33 INTEGER :: jn 33 34 !!--------------------------------------------------------------------- 35 IF( ln_crs ) CALL iom_swap( "nemo_crs" ) 34 36 35 37 ! write the tracer concentrations in the file … … 37 39 DO jn = jp_myt0, jp_myt1 38 40 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 39 CALL iom_put( cltra, trn(:,:,:,jn) ) 41 IF( lk_vvl ) THEN 42 CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) ) 43 ELSE 44 CALL iom_put( TRIM(cltra), trn(:,:,:,jn) ) 45 ENDIF 40 46 END DO 47 ! 48 IF( ln_crs ) CALL iom_swap( "nemo" ) 41 49 ! 42 50 END SUBROUTINE trc_wri_my_trc -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r4990 r5105 17 17 USE trcnam_trp ! passive tracers transport namelist variables 18 18 USE trabbl ! bottom boundary layer (trc_bbl routine) 19 USE trabbl_crs ! bottom boundary layer (trc_bbl routine) 19 20 USE trcbbl ! bottom boundary layer (trc_bbl routine) 21 USE trcbbl_crs ! bottom boundary layer (trc_bbl routine) 20 22 USE zdfkpp ! KPP non-local tracer fluxes (trc_kpp routine) 21 23 USE trcdmp ! internal damping (trc_dmp routine) 22 24 USE trcldf ! lateral mixing (trc_ldf routine) 25 USE trcldf_crs ! lateral mixing (trc_ldf routine) 23 26 USE trcadv ! advection (trc_adv routine) 27 USE trcadv_crs ! advection (trc_adv routine) 24 28 USE trczdf ! vertical diffusion (trc_zdf routine) 29 USE trczdf_crs ! vertical diffusion (trc_zdf routine 25 30 USE trcnxt ! time-stepping (trc_nxt routine) 26 31 USE trcrad ! positivity (trc_rad routine) 27 32 USE trcsbc ! surface boundary condition (trc_sbc routine) 33 USE trcsbc_crs ! surface boundary condition (trc_sbc routine) 28 34 USE zpshde ! partial step: hor. derivative (zps_hde routine) 35 USE zpshde_crs ! partial step: hor. derivative (zps_hde routine) 36 USE dom_oce , ONLY : ln_crs 37 USe crs, ONLY : jpi_crs,jpj_crs,wn_crs !cbr 29 38 30 39 #if defined key_agrif … … 58 67 !!---------------------------------------------------------------------- 59 68 INTEGER, INTENT( in ) :: kstp ! ocean time-step index 69 REAL(wp) :: zmin,zmax 70 INTEGER :: ji,jj,jk 60 71 !! --------------------------------------------------------------------- 61 72 ! … … 64 75 IF( .NOT. lk_c1d ) THEN 65 76 ! 66 CALL trc_sbc( kstp ) ! surface boundary condition 67 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 77 ! CALL test(kstp,1) 78 ! IF( ln_crs ) THEN ; CALL trc_sbc_crs( kstp ) 79 ! ELSE ; CALL trc_sbc( kstp ) 80 ! ENDIF 81 ! CALL test(kstp,2) 82 IF( ln_crs ) THEN ; CALL trc_bbl_crs( kstp ) 83 ELSE ; CALL trc_bbl( kstp ) 84 ENDIF 68 85 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 86 ! CALL test(kstp,3) 87 88 IF( ln_crs ) THEN ; CALL trc_adv_crs( kstp ) 89 ELSE ; CALL trc_adv( kstp ) 90 ENDIF 91 ! CALL test(kstp,4) 92 69 93 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 70 CALL trc_adv( kstp ) ! horizontal & vertical advection 71 CALL trc_ldf( kstp ) ! lateral mixing 94 IF( ln_crs ) THEN ; CALL trc_ldf_crs( kstp ) 95 ELSE ; CALL trc_ldf( kstp ) 96 ENDIF 97 ! CALL test(kstp,5) 72 98 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 73 99 & CALL trc_kpp( kstp ) ! KPP non-local tracer fluxes … … 75 101 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge 76 102 #endif 77 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 103 IF( ln_crs ) THEN ; CALL trc_zdf_crs( kstp ) 104 ELSE ; CALL trc_zdf( kstp ) 105 ENDIF 106 ! CALL test(kstp,6) 78 107 CALL trc_nxt( kstp ) ! tracer fields at next time step 108 ! CALL test(kstp,7) 79 109 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 80 110 … … 82 112 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp ) ! Update tracer at AGRIF zoom boundaries : children only 83 113 #endif 84 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi ) ! Partial steps: now horizontal gradient of passive 114 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 115 IF( ln_zps )THEN 116 IF( ln_crs ) THEN ; CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv ) 117 ELSE ; CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) 118 ENDIF 119 ENDIF 85 120 ! tracers at the bottom ocean level 86 121 ! … … 98 133 ! 99 134 END SUBROUTINE trc_trp 135 SUBROUTINE test(kt,i) 136 INTEGER,INTENT(IN) :: kt,i 137 REAL(wp)::zmin,zmax 138 INTEGER :: ji,jj,jk 139 zmin=MINVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 140 zmax=MAXVAL( trb(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 141 IF(lwp)WRITE(numout,*)"trctrp b ",kt,i,zmin,zmax 142 zmin=MINVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 143 zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 144 IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax 145 zmin=MINVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_min(zmin) 146 zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,:,1),mask=(tmask(2:jpi-1,2:jpj-1,:)==1)) ; CALL mpp_max(zmax) 147 IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax 148 zmin=MINVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin) 149 zmax=MAXVAL( trn(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax) 150 IF(lwp)WRITE(numout,*)"trctrp n ",kt,i,zmin,zmax 151 zmin=MINVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_min(zmin) 152 zmax=MAXVAL( tra(2:jpi-1,2:jpj-1,1:jpk-1,1),mask=(tmask(2:jpi-1,2:jpj-1,1:jpk-1)==1)) ; CALL mpp_max(zmax) 153 IF(lwp)WRITE(numout,*)"trctrp a ",kt,i,zmin,zmax 100 154 155 IF(narea==267)WRITE(narea+5000,*)"tra(17,5,74,1) = ",kt,i,tra(17,5,74,1) 156 157 DO ji=1,jpi 158 DO jj=1,jpj 159 DO jk=1,jpk 160 IF( tra(ji,jj,jk,1) .NE. tra(ji,jj,jk,1) )WRITE(narea+200,*)"BUG7 ",ji,jj,jk, tra(ji,jj,jk,1); CALL FLUSH(narea+200) 161 ENDDO 162 ENDDO 163 ENDDO 164 165 END SUBROUTINE test 101 166 #else 102 167 !!---------------------------------------------------------------------- -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r4990 r5105 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_top 10 11 #if defined key_crs 12 13 !* Domain size * 14 USE par_oce , ONLY : jpi => jpi !: first dimension of grid --> i 15 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j 16 USE par_oce , ONLY : jpk => jpk !: number of levels 17 USE par_oce , ONLY : jpim1 => jpim1 !: jpi - 1 18 USE par_oce , ONLY : jpjm1 => jpjm1 !: jpj - 1 19 USE par_oce , ONLY : jpkm1 => jpkm1 !: jpk - 1 20 USE par_oce , ONLY : jpij => jpij !: jpi x jpj 21 USE par_oce , ONLY : lk_esopa => lk_esopa !: flag to activate the all option 22 USE par_oce , ONLY : jp_tem => jp_tem !: indice for temperature 23 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 24 25 !* IO manager * 26 USE in_out_manager 27 28 !* Memory Allocation * 29 USE wrk_nemo 30 31 !* Timing * 32 USE timing, ONLY : timing_start , timing_stop 33 34 !* MPP library 35 USE lib_mpp 36 37 !* Fortran utilities 38 USE lib_fortran 39 40 !* Lateral boundary conditions 41 USE lbclnk 42 43 !* physical constants * 44 USE phycst 45 46 !* 1D configuration 47 USE c1d 48 49 !* model domain * 50 USE dom_oce , ONLY : narea => narea 51 USE dom_oce , ONLY : nproc => nproc 52 USE dom_oce , ONLY : nimpp => nimpp 53 USE dom_oce , ONLY : njmpp => njmpp 54 USE dom_oce , ONLY : nreci => nreci 55 USE dom_oce , ONLY : nrecj => nrecj 56 USE dom_oce , ONLY : nlci => nlci 57 USE dom_oce , ONLY : nldi => nldi 58 USE dom_oce , ONLY : nlei => nlei 59 USE dom_oce , ONLY : nlcj => nlcj 60 USE dom_oce , ONLY : nldj => nldj 61 USE dom_oce , ONLY : nlej => nlej 62 USE dom_oce , ONLY : nlcit => nlcit 63 USE dom_oce , ONLY : nldit => nldit 64 USE dom_oce , ONLY : nleit => nleit 65 USE dom_oce , ONLY : nlcjt => nlcjt 66 USE dom_oce , ONLY : nldjt => nldjt 67 USE dom_oce , ONLY : nlejt => nlejt 68 USE dom_oce , ONLY : nimppt => nimppt 69 USE dom_oce , ONLY : njmppt => njmppt 70 USE dom_oce , ONLY : ibonit => ibonit 71 USE dom_oce , ONLY : ibonjt => ibonjt 72 USE dom_oce , ONLY : lk_vvl => lk_vvl 73 USE dom_oce , ONLY : rdt => rdt 74 USE dom_oce , ONLY : ln_zco => ln_zco 75 USE dom_oce , ONLY : ln_zps => ln_zps 76 USE dom_oce , ONLY : ln_sco => ln_sco 77 USE dom_oce , ONLY : neuler => neuler 78 79 USE crs, ONLY : mi0 => mi0 80 USE crs, ONLY : mi1 => mi1 81 USE crs, ONLY : mj0 => mj0 82 USE crs, ONLY : mj1 => mj1 83 84 USE dom_oce , ONLY : lzoom => lzoom 85 !USE dom_oce , ONLY : => 86 87 !* horizontal mesh * 88 USE crs , ONLY : glamt => glamt_crs !: longitude of t-point (degre) 89 USE crs , ONLY : glamu => glamu_crs !: longitude of t-point (degre) 90 USE crs , ONLY : glamv => glamv_crs !: longitude of t-point (degre) 91 USE crs , ONLY : glamf => glamf_crs !: longitude of t-point (degre) 92 USE crs , ONLY : gphit => gphit_crs !: latitude of t-point (degre) 93 USE crs , ONLY : gphiu => gphiu_crs !: latitude of t-point (degre) 94 USE crs , ONLY : gphiv => gphiv_crs !: latitude of t-point (degre) 95 USE crs , ONLY : gphif => gphif_crs !: latitude of t-point (degre) 96 USE crs , ONLY : e1t => e1t_crs !: horizontal scale factors at t-point (m) 97 USE crs , ONLY : e2t => e2t_crs !: horizontal scale factors at t-point (m) 98 USE crs , ONLY : e1e2t => e1e2t_crs !: cell surface at t-point (m2) 99 USE crs , ONLY : e1u => e1u_crs !: horizontal scale factors at u-point (m) 100 USE crs , ONLY : e2u => e2u_crs !: horizontal scale factors at u-point (m) 101 USE crs , ONLY : e1v => e1v_crs !: horizontal scale factors at v-point (m) 102 USE crs , ONLY : e2v => e2v_crs !: horizontal scale factors at v-point (m) 103 USE crs , ONLY : e3t => e3t_crs !: vertical scale factors at t- 104 USE crs , ONLY : e3t_0 => e3t_crs !: vertical scale factors at t- 105 USE crs , ONLY : fse3t => e3t_crs 106 USE crs , ONLY : fse3t_b => e3t_crs 107 USE crs , ONLY : fse3t_a => e3t_crs 108 USE crs , ONLY : fse3w => e3w_crs 109 USE crs , ONLY : e3u => e3u_crs !: vertical scale factors at u- 110 USE crs , ONLY : e3u_0 => e3u_crs !: vertical scale factors at u- 111 USE crs , ONLY : e3v => e3v_crs !: vertical scale factors v- 112 USE crs , ONLY : e3v_0 => e3v_crs !: vertical scale factors v- 113 USE crs , ONLY : e3w => e3w_crs !: w-points (m) 114 USE crs , ONLY : e3w_0 => e3w_crs !: w-points (m) 115 USE crs , ONLY : e3f => e3f_crs !: f-points (m) 116 USE crs , ONLY : ff => ff_crs !: f-points (m) 117 118 USE crs , ONLY : gdept_0 => gdept_crs !: depth of t-points (m) 119 USE dom_oce , ONLY : gdept_1d => gdept_1d !: depth of t-points (m) 120 #if defined key_zco 121 USE crs , ONLY : gdept => gdept_crs !: depth of t-points (m) 122 USE crs , ONLY : gdepw => gdepw_crs !: depth of t-points (m) 123 #endif 124 !* masks, bathymetry * 125 USE crs , ONLY : mbkt => mbkt_crs !: vertical index of the bottom last T- ocean level 126 USE crs , ONLY : mbku => mbku_crs !: vertical index of the bottom last U- ocean level 127 USE crs , ONLY : mbkv => mbkv_crs !: vertical index of the bottom last V- ocean level 128 USE crs , ONLY : tmask_i => tmask_i_crs !: Interior mask at t-points 129 USE crs , ONLY : tmask => tmask_crs !: land/ocean mask at t-points 130 USE crs , ONLY : umask => umask_crs !: land/ocean mask at u-points 131 USE crs , ONLY : vmask => vmask_crs !: land/ocean mask at v-points 132 USE crs , ONLY : fmask => fmask_crs !: land/ocean mask at f-points 133 134 !* ocean fields: here now and after fields * 135 !cbr? USE crs , ONLY : ua => ua_crs !: i-horizontal velocity (m s-1) 136 !cbr? USE crs , ONLY : va => va_crs !: j-horizontal velocity (m s-1) 137 USE crs , ONLY : un => un_crs !: i-horizontal velocity (m s-1) 138 USE crs , ONLY : vn => vn_crs !: j-horizontal velocity (m s-1) 139 USE crs , ONLY : wn => wn_crs !: vertical velocity (m s-1) 140 USE crs , ONLY : tsn => tsn_crs !: 4D array contaning ( tn, sn ) 141 USE oce , ONLY : tsb => tsb !: 4D array contaning ( tb, sb ) 142 USE oce , ONLY : tsa => tsa !: 4D array contaning ( ta, sa ) 143 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 144 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 145 USE crs , ONLY : hdivn => hdivn_crs !: horizontal divergence (1/s) 146 USE crs , ONLY : hdivb => hdivb_crs !: horizontal divergence (1/s) 147 USE crs , ONLY : sshb => sshb_crs !: sea surface height at t-point [m] 148 USE crs , ONLY : sshn => sshn_crs !: sea surface height at t-point [m] 149 USE crs , ONLY : ssha => ssha_crs !: sea surface height at t-point [m] 150 151 !* surface fluxes * 152 USE crs , ONLY : utau => utau_crs !: i-surface stress component 153 USE crs , ONLY : vtau => vtau_crs !: j-surface stress component 154 USE crs , ONLY : wndm => wndm_crs !: 10m wind speed 155 USE crs , ONLY : qsr => qsr_crs !: penetrative solar radiation (w m-2) 156 USE crs , ONLY : emp => emp_crs !: freshwater budget: volume flux [Kg/m2/s] 157 USE crs , ONLY : emp_b => emp_b_crs !: freshwater budget: volume flux [Kg/m2/s] 158 USE crs , ONLY : sfx => sfx_crs !: freshwater budget: concentration/dillution [Kg/m2/s] 159 USE crs , ONLY : fmmflx => fmmflx_crs !: freshwater budget: volume flux [Kg/m2/s] 160 USE crs , ONLY : rnf => rnf_crs !: river runoff [Kg/m2/s] 161 USE crs , ONLY : fr_i => fr_i_crs !: ice fraction (between 0 to 1) 162 163 USE crs , ONLY : avt => avt_crs !: vert. diffusivity coef. at w-point for temp 164 #if defined key_zdfddm 165 USE crs , ONLY : avs => avs_crs !: salinity vertical diffusivity coeff. at w-point 166 #endif 167 168 !cbr USE trc_oce 169 USE trc_oce, ONLY : lk_offline 170 USE trc_oce, ONLY : nn_dttrc 171 172 USE crs , ONLY : nmln => nmln_crs !: number of level in the mixed layer 173 USE crs , ONLY : hmld => hmld_crs !: mixing layer depth (turbocline) 174 USE crs , ONLY : hmlp => hmlp_crs !: mixed layer depth (rho=rho0+zdcrit) (m) 175 USE crs , ONLY : hmlpt => hmlpt_crs !: mixed layer depth at t-points (m) 176 177 !* direction of lateral diffusion * 178 #if defined key_ldfslp 179 USE ldfslp_crs , ONLY : uslp => uslp_crs !: i-direction slope at u-, w-points 180 USE ldfslp_crs , ONLY : vslp => vslp_crs !: j-direction slope at v-, w-points 181 USE ldfslp_crs , ONLY : wslpi => wslpi_crs !: i-direction slope at u-, w-points 182 USE ldfslp_crs , ONLY : wslpj => wslpj_crs !: j-direction slope at v-, w-points 183 #endif 184 185 #else 186 10 187 !!---------------------------------------------------------------------- 11 188 !! 'key_top' TOP models … … 24 201 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 25 202 203 !* model domain * 204 USE dom_oce , ONLY : narea => narea 205 USE dom_oce , ONLY : nproc => nproc 206 USE dom_oce , ONLY : nimpp => nimpp 207 USE dom_oce , ONLY : njmpp => njmpp 208 USE dom_oce , ONLY : nreci => nreci 209 USE dom_oce , ONLY : nrecj => nrecj 210 USE dom_oce , ONLY : nlci => nlci 211 USE dom_oce , ONLY : nldi => nldi 212 USE dom_oce , ONLY : nlei => nlei 213 USE dom_oce , ONLY : nlcj => nlcj 214 USE dom_oce , ONLY : nldj => nldj 215 USE dom_oce , ONLY : nlej => nlej 216 USE dom_oce , ONLY : nlcit => nlcit 217 USE dom_oce , ONLY : nldit => nldit 218 USE dom_oce , ONLY : nleit => nleit 219 USE dom_oce , ONLY : nlcjt => nlcjt 220 USE dom_oce , ONLY : nldjt => nldjt 221 USE dom_oce , ONLY : nlejt => nlejt 222 USE dom_oce , ONLY : nimppt => nimppt 223 USE dom_oce , ONLY : njmppt => njmppt 224 USE dom_oce , ONLY : ibonit => ibonit 225 USE dom_oce , ONLY : ibonjt => ibonjt 226 USE dom_oce , ONLY : lk_vvl => lk_vvl 227 USE dom_oce , ONLY : rdt => rdt 228 USE dom_oce , ONLY : ln_zco => ln_zco 229 USE dom_oce , ONLY : ln_zps => ln_zps 230 USE dom_oce , ONLY : ln_sco => ln_sco 231 USE dom_oce , ONLY : neuler => neuler 232 233 USE dom_oce, ONLY : mi0 => mi0 234 USE dom_oce, ONLY : mi1 => mi1 235 USE dom_oce, ONLY : mj0 => mj0 236 USE dom_oce, ONLY : mj1 => mj1 237 238 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 239 USE dom_oce , ONLY : glamu => glamu !: longitude of t-point (degre) 240 USE dom_oce , ONLY : glamv => glamv !: longitude of t-point (degre) 241 USE dom_oce , ONLY : glamf => glamf !: longitude of t-point (degre) 242 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 243 USE dom_oce , ONLY : gphiu => gphiu !: latitude of t-point (degre) 244 USE dom_oce , ONLY : gphiv => gphiv !: latitude of t-point (degre) 245 USE dom_oce , ONLY : gphif => gphif !: latitude of t-point (degre) 246 USE dom_oce , ONLY : e1t => e1t !: horizontal scale factors at t-point (m) 247 USE dom_oce , ONLY : e2t => e2t !: horizontal scale factors at t-point (m) 248 USE dom_oce , ONLY : e1e2t => e1e2t !: cell surface at t-point (m2) 249 USE dom_oce , ONLY : e1u => e1u !: horizontal scale factors at u-point (m) 250 USE dom_oce , ONLY : e2u => e2u !: horizontal scale factors at u-point (m) 251 USE dom_oce , ONLY : e1v => e1v !: horizontal scale factors at v-point (m) 252 USE dom_oce , ONLY : e2v => e2v !: horizontal scale factors at v-point (m) 253 USE dom_oce , ONLY : e3t => e3t_0 !: vertical scale factors at t- 254 USE dom_oce , ONLY : e3t_0 => e3t_0 !: vertical scale factors at t- 255 USE dom_oce , ONLY : fse3t => e3t_0 256 USE dom_oce , ONLY : fse3t_b => e3t_0 257 USE dom_oce , ONLY : fse3t_a => e3t_0 258 USE dom_oce , ONLY : fse3w => e3w_0 259 USE dom_oce , ONLY : e3u => e3u_0 !: vertical scale factors at u- 260 USE dom_oce , ONLY : e3u_0 => e3u_0 !: vertical scale factors at u- 261 USE dom_oce , ONLY : e3v => e3v_0 !: vertical scale factors v- 262 USE dom_oce , ONLY : e3v_0 => e3v_0 !: vertical scale factors v- 263 USE dom_oce , ONLY : e3w => e3w_0 !: w-points (m) 264 USE dom_oce , ONLY : e3w_0 => e3w_0 !: w-points (m) 265 USE dom_oce , ONLY : e3f => e3f_0 !: f-points (m) 266 USE dom_oce , ONLY : ff => ff !: f-points (m) 267 USE dom_oce , ONLY : gdept_0 => gdept_0 !: f-points (m) 268 USE dom_oce , ONLY : gdept_1d => gdept_1d !: f-points (m) 269 USE dom_oce , ONLY : tmask => tmask !: f-points (m) 270 USE dom_oce , ONLY : umask => umask !: f-points (m) 271 USE dom_oce , ONLY : vmask => vmask !: f-points (m) 272 USE dom_oce , ONLY : tmask_i => tmask_i !: f-points (m) 273 USE dom_oce , ONLY : mbkt => mbkt !: f-points (m) 274 USE dom_oce , ONLY : mbku => mbku !: f-points (m) 275 USE dom_oce , ONLY : mbkv => mbkv !: f-points (m) 276 26 277 !* IO manager * 27 278 USE in_out_manager … … 49 300 50 301 !* model domain * 51 USE dom_oce 302 !cbr USE dom_oce , ONLY : e3w_0 303 USE dom_oce , ONLY : lzoom => lzoom 52 304 53 305 USE domvvl, ONLY : un_td, vn_td !: thickness diffusion transport … … 66 318 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 67 319 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 68 #if defined key_offline69 USE oce , ONLY : rab_n => rab_n !: local thermal/haline expension ratio at T-points70 #endif71 320 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 72 321 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1] … … 135 384 # endif 136 385 386 #endif 137 387 #else 138 388 !!---------------------------------------------------------------------- -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r4292 r5105 20 20 !! trcdib_wr : outputs of biological fields 21 21 !!---------------------------------------------------------------------- 22 USE dom_oce ! ocean space and time domain variables 23 USE oce_trc 22 USE trc_oce, ONLY : lk_offline ! offline flag 24 23 USE trc 25 24 USE par_trc -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r4624 r5105 19 19 USE oce_trc ! shared variables between ocean and passive tracers 20 20 USE trc ! passive tracers common variables 21 USE iom ! I/O manager22 21 USE lib_mpp ! MPP library 23 22 USE fldread ! read input fields -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r4990 r5105 25 25 USE trcini_my_trc ! MY_TRC initialisation 26 26 USE trcdta ! initialisation from files 27 USE daymod ! calendar manager28 USE zpshde 27 USE zpshde,ONLY: zps_hde ! partial step: hor. derivative (zps_hde routine) 28 USE zpshde_crs ! partial step: hor. derivative (zps_hde routine) 29 29 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 30 30 USE trcsub ! variables to substep passive tracers 31 31 USE lib_mpp ! distribued memory computing library 32 USE sbc_oce 32 USE sbc_oce, ONLY : ltrcdm2dc 33 USE crs , ONLY : ln_crs 34 USE dom_oce, ONLY : nn_cla 33 35 34 36 IMPLICIT NONE … … 143 145 144 146 tra(:,:,:,:) = 0._wp 145 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 146 & CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi ) ! tracers at the bottom ocean level 147 147 IF( ln_zps .AND. .NOT. lk_c1d )THEN ! Partial steps: before horizontal gradient of passive 148 IF( ln_crs ) THEN 149 CALL zps_hde_crs( nit000, jptra, trn, gtru, gtrv ) 150 ELSE 151 CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )! tracers at the bottom ocean level 152 ENDIF 153 ENDIF 148 154 ! 149 155 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers … … 188 194 !!---------------------------------------------------------------------- 189 195 USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines... 196 USE trcadv_crs , ONLY: trc_adv_alloc_crs ! TOP-related alloc routines.. 190 197 USE trc , ONLY: trc_alloc 191 198 USE trcnxt , ONLY: trc_nxt_alloc 192 199 USE trczdf , ONLY: trc_zdf_alloc 200 USE trczdf_crs , ONLY: trc_zdf_alloc_crs 193 201 USE trdtrc_oce , ONLY: trd_trc_oce_alloc 194 202 #if defined key_trdmxl_trc … … 200 208 ! 201 209 ierr = trc_adv_alloc() ! Start of TOP-related alloc routines... 210 ierr = ierr + trc_adv_alloc_crs() 202 211 ierr = ierr + trc_alloc () 203 212 ierr = ierr + trc_nxt_alloc() 204 213 ierr = ierr + trc_zdf_alloc() 214 ierr = ierr + trc_zdf_alloc_crs() 205 215 ierr = ierr + trd_trc_oce_alloc() 206 216 #if defined key_trdmxl_trc -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r4990 r5105 23 23 !! trc_rst_wri : write restart file 24 24 !!---------------------------------------------------------------------- 25 USE oce_trc 25 USE oce_trc ! ,ONLY: jprstlib 26 26 USE trc 27 27 USE trcnam_trp 28 USE iom 29 USE daymod 28 USE iom_def , ONLY : jprstlib , jprstdimg , jpnf90 , jpdom_autoglo 29 USE iom , ONLY : iom_open , iom_get , iom_varid , iom_rstput , iom_close 30 USE dom_oce, ONLY: ndastp ,adatrj , rdttra 31 USE daymod , ONLY : day_init 32 30 33 IMPLICIT NONE 31 34 PRIVATE … … 137 140 CALL trc_rst_stat ! statistics 138 141 CALL iom_close( numrtw ) ! close the restart file (only at last time step) 139 #if ! defined key_trdm xl_trc142 #if ! defined key_trdmld_trc 140 143 lrst_trc = .FALSE. 141 144 #endif -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r4990 r5105 11 11 !!---------------------------------------------------------------------- 12 12 USE oce_trc ! ocean dynamics and active tracers variables 13 USE sbc_oce 13 USE sbc_oce , ONLY : ltrcdm2dc,qsr_mean 14 14 USE trc 15 15 USE trctrp ! passive tracers transport … … 17 17 USE prtctl_trc ! Print control for debbuging 18 18 USE trcdia 19 USE trcwri 19 USE trcwri , ONLY : trc_wri 20 20 USE trcrst 21 21 USE trdtrc_oce 22 22 USE trdmxl_trc 23 USE iom 23 USE iom, ONLY : lk_iomput , iom_close 24 24 USE in_out_manager 25 25 USE trcsub 26 USE dom_oce, ONLY : nday, nmonth, nyear 26 27 27 28 IMPLICIT NONE -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r4611 r5105 13 13 USE trc 14 14 USE prtctl_trc ! Print control for debbuging 15 USE iom 16 USE in_out_manager 15 USE iom, ONLY : jpnf90 16 USE in_out_manager, ONLY : jprstlib 17 17 USE lbclnk 18 #if defined key_zdftke19 USE zdftke ! twice TKE (en)20 #endif18 !#if defined key_zdftke 19 ! USE zdftke ! twice TKE (en) 20 !#endif 21 21 #if defined key_zdfgls 22 22 USE zdfgls, ONLY: en 23 23 #endif 24 USE trabbl25 USE zdf_oce26 USE domvvl27 USE divcur ! hor. divergence and curl (div & cur routines)24 ! USE trabbl 25 ! USE zdf_oce 26 ! USE domvvl 27 USE divcur, ONLY : div_cur ! hor. divergence and curl (div & cur routines) 28 28 USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff 29 29 USE bdy_oce … … 160 160 wndm_temp (:,:) = wndm (:,:) 161 161 ! ! Variables reset in trc_sub_ssh 162 #if ! defined key_crs 162 163 rotn_temp (:,:,:) = rotn (:,:,:) 164 # endif 163 165 hdivn_temp (:,:,:) = hdivn (:,:,:) 166 #if ! defined key_crs 164 167 rotb_temp (:,:,:) = rotb (:,:,:) 168 # endif 165 169 hdivb_temp (:,:,:) = hdivb (:,:,:) 166 170 ! … … 396 400 ! 397 401 hdivn (:,:,:) = hdivn_temp (:,:,:) 402 hdivb (:,:,:) = hdivb_temp (:,:,:) 403 #if ! defined key_crs 398 404 rotn (:,:,:) = rotn_temp (:,:,:) 399 hdivb (:,:,:) = hdivb_temp (:,:,:)400 405 rotb (:,:,:) = rotb_temp (:,:,:) 406 #endif 401 407 ! 402 408
Note: See TracChangeset
for help on using the changeset viewer.
