- Timestamp:
- 2011-02-27T13:45:53+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2619 r2623 58 58 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 59 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: r2dtra !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 60 61 61 62 ! !!* Namelist namcla : cross land advection … … 261 262 ierr(:) = 0 262 263 263 ALLOCATE( rdttra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) )264 ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 264 265 265 266 ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , & -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2590 r2623 32 32 PUBLIC tra_adv ! routine called by step module 33 33 PUBLIC tra_adv_init ! routine called by opa module 34 PUBLIC tra_adv_alloc ! routine called by nemogcm module35 34 36 35 ! !!* Namelist namtra_adv * … … 44 43 INTEGER :: nadv ! choice of the type of advection scheme 45 44 46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=047 48 45 !! * Substitutions 49 46 # include "domzgr_substitute.h90" … … 55 52 !!---------------------------------------------------------------------- 56 53 CONTAINS 57 58 FUNCTION tra_adv_alloc()59 !!----------------------------------------------------------------------60 !! *** ROUTINE tra_adv_alloc ***61 !!----------------------------------------------------------------------62 IMPLICIT none63 INTEGER tra_adv_alloc64 !!----------------------------------------------------------------------65 66 ALLOCATE( r2dt(jpk), Stat=tra_adv_alloc)67 68 IF(tra_adv_alloc /= 0)THEN69 CALL ctl_warn('tra_adv_alloc: failed to allocate array.')70 END IF71 72 END FUNCTION tra_adv_alloc73 54 74 55 SUBROUTINE tra_adv( kt ) … … 80 61 !! ** Method : - Update (ua,va) with the advection term following nadv 81 62 !!---------------------------------------------------------------------- 82 USE wrk_nemo, ONLY: wrk_use, wrk_release 83 USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3 63 USE wrk_nemo, ONLY: wrk_use, wrk_release 64 USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3 ! 3D workspace 65 ! 84 66 INTEGER, INTENT( in ) :: kt ! ocean time-step index 85 67 ! … … 87 69 !!---------------------------------------------------------------------- 88 70 ! 89 IF(.not. wrk_use(3,1,2,3))THEN 90 CALL ctl_stop('tra_adv: ERROR: requested workspace arrays unavailable') 91 RETURN 71 IF(.not. wrk_use(3, 1,2,3) ) THEN 72 CALL ctl_stop('tra_adv: requested workspace arrays unavailable') ; RETURN 92 73 END IF 93 74 ! ! set time step 94 75 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 95 r2dt (:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)76 r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping) 96 77 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 97 r2dt (:) = 2. * rdttra(:)! = 2 rdttra (leapfrog)78 r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog) 98 79 ENDIF 99 80 ! … … 118 99 119 100 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 120 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered121 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD122 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL123 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2124 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS125 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST101 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 102 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 103 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 104 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 105 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 106 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 126 107 ! 127 108 CASE (-1 ) !== esopa: test all possibility with control print ==! 128 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )109 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 129 110 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 130 111 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 131 CALL tra_adv_tvd ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )112 CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 132 113 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 133 114 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 134 CALL tra_adv_muscl ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsa, jpts )115 CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) 135 116 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 136 117 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 137 CALL tra_adv_muscl2( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )118 CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 138 119 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 139 120 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 CALL tra_adv_ubs ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )121 CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 141 122 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 142 123 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 143 CALL tra_adv_qck ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )124 CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 144 125 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 145 126 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 150 131 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 151 132 ! 152 IF(.not. wrk_release(3,1,2,3))THEN 153 CALL ctl_stop('tra_adv: ERROR: failed to release workspace arrays') 154 RETURN 155 END IF 133 IF(.not. wrk_release(3,1,2,3) ) CALL ctl_stop('tra_adv: failed to release workspace arrays') 156 134 ! 157 135 END SUBROUTINE tra_adv … … 172 150 !!---------------------------------------------------------------------- 173 151 174 REWIND ( numnam )! Read Namelist namtra_adv : tracer advection scheme175 READ 152 REWIND( numnam ) ! Read Namelist namtra_adv : tracer advection scheme 153 READ ( numnam, namtra_adv ) 176 154 177 155 IF(lwp) THEN ! Namelist print -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2590 r2623 37 37 PUBLIC tra_adv_cen2 ! routine called by step.F90 38 38 PUBLIC ups_orca_set ! routine used by traadv_cen2_jki.F90 39 PUBLIC tra_adv_cen2_alloc ! routine called by nemogcm.F9040 39 41 40 LOGICAL :: l_trd ! flag to compute trends … … 52 51 !!---------------------------------------------------------------------- 53 52 CONTAINS 54 55 FUNCTION tra_adv_cen2_alloc()56 !!----------------------------------------------------------------------57 !! *** ROUTINE tra_adv_cen2_alloc ***58 !!----------------------------------------------------------------------59 IMPLICIT none60 INTEGER :: tra_adv_cen2_alloc61 !!----------------------------------------------------------------------62 63 ALLOCATE(upsmsk(jpi,jpj), Stat=tra_adv_cen2_alloc)64 65 IF(tra_adv_cen2_alloc > 0)THEN66 CALL ctl_warn('tra_adv_cen2_alloc: failed to allocate array.')67 END IF68 69 END FUNCTION tra_adv_cen2_alloc70 53 71 54 SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn, & … … 140 123 !! 141 124 INTEGER :: ji, jj, jk, jn ! dummy loop indices 142 REAL(wp) :: zbtr, ztra ! temporary scalars143 REAL(wp) :: z fp_ui, zfp_vj, zfp_w ! - -144 REAL(wp) :: zf m_ui, zfm_vj, zfm_w ! --145 REAL(wp) :: z cofi , zcofj , zcofk ! --146 REAL(wp) :: z upsut, zcenut ! --147 REAL(wp) :: zups vt, zcenvt ! --148 REAL(wp) :: zups t , zcent ! --149 REAL(wp) :: z ice ! --150 !!----------------------------------------------------------------------151 152 IF( (.not. wrk_use(2, 1)) .OR. (.not. wrk_use(3, 1,2)))THEN 153 CALL ctl_stop('tra_adv_cen2: ERROR: requested workspace arrays unavailable')154 RETURN125 INTEGER :: ierr ! local integer 126 REAL(wp) :: zbtr, ztra ! local scalars 127 REAL(wp) :: zfp_ui, zfp_vj, zfp_w ! - - 128 REAL(wp) :: zfm_ui, zfm_vj, zfm_w ! - - 129 REAL(wp) :: zcofi , zcofj , zcofk ! - - 130 REAL(wp) :: zupsut, zcenut ! - - 131 REAL(wp) :: zupsvt, zcenvt ! - - 132 REAL(wp) :: zupst , zcent ! - - 133 REAL(wp) :: zice ! - - 134 !!---------------------------------------------------------------------- 135 136 IF( .not. wrk_use(2, 1) .OR. .not. wrk_use(3, 1,2) ) THEN 137 CALL ctl_stop('tra_adv_cen2: ERROR: requested workspace arrays unavailable') ; RETURN 155 138 END IF 156 139 … … 161 144 IF(lwp) WRITE(numout,*) 162 145 ! 163 upsmsk(:,:) = 0.e0 ! not upstream by default 146 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 147 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 148 ! 149 upsmsk(:,:) = 0._wp ! not upstream by default 164 150 ! 165 151 IF( cp_cfg == "orca" ) CALL ups_orca_set ! set mixed Upstream/centered scheme near some straits … … 173 159 ! 174 160 l_trd = .FALSE. 175 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.161 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 176 162 ENDIF 177 163 ! -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r2590 r2623 17 17 !! 'key_trabbl' or bottom boundary layer 18 18 !!---------------------------------------------------------------------- 19 !! tra_bbl_alloc : allocate trabbl arrays 19 20 !! tra_bbl : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 20 21 !! tra_bbl_dif : generic routine to compute bbl diffusive trend … … 42 43 PUBLIC tra_bbl_adv ! - - - - 43 44 PUBLIC bbl ! routine called by trcbbl.F90 and dtadyn.F90 44 PUBLIC tra_bbl_alloc ! routine called by nemogcm.F9045 45 46 46 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .TRUE. !: bottom boundary layer flag … … 54 54 REAL(wp), PUBLIC :: rn_gambbl = 10.0_wp !: lateral coeff. for bottom boundary layer scheme [s] 55 55 56 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 57 56 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coeff icients at u and v-points59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coeff. at u & v-pts 58 60 59 61 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku_d , mbkv_d ! vertical index of the "lower" bottom ocean U/V-level … … 61 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 62 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t_r ! thichness of the bbl (e3) at u and v-points 64 LOGICAL, PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_e1e2t ! inverse of the cell surface at t-point [1/m2] 65 66 66 67 !! * Substitutions … … 74 75 CONTAINS 75 76 76 FUNCTION tra_bbl_alloc() 77 IMPLICIT none 78 INTEGER :: tra_bbl_alloc 79 80 ALLOCATE(utr_bbl(jpi,jpj), vtr_bbl(jpi,jpj), & 81 ahu_bbl(jpi,jpj), ahv_bbl(jpi,jpj), & 82 mbku_d(jpi,jpj), mbkv_d(jpi,jpj), & 83 mgrhu(jpi,jpj), mgrhv(jpi,jpj), & 84 ahu_bbl_0(jpi,jpj), ahv_bbl_0(jpi,jpj), & 85 e3u_bbl_0(jpi,jpj), e3v_bbl_0(jpi,jpj), & 86 e1e2t_r(jpi,jpj), & 87 Stat=tra_bbl_alloc) 88 89 IF(tra_bbl_alloc > 0)THEN 90 CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 91 END IF 92 77 INTEGER FUNCTION tra_bbl_alloc() 78 !!---------------------------------------------------------------------- 79 !! *** FUNCTION tra_bbl_alloc *** 80 !!---------------------------------------------------------------------- 81 ALLOCATE( utr_bbl (jpi,jpj) , ahu_bbl (jpi,jpj) , mbku_d (jpi,jpj) , mgrhu(jpi,jpj) , & 82 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d (jpi,jpj) , mgrhv(jpi,jpj) , & 83 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 84 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj) , STAT=tra_bbl_alloc) 85 ! 86 IF( lk_mpp ) CALL mpp_sum ( tra_bbl_alloc ) 87 IF( tra_bbl_alloc > 0 ) CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 93 88 END FUNCTION tra_bbl_alloc 89 94 90 95 91 SUBROUTINE tra_bbl( kt ) … … 173 169 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 174 170 !!---------------------------------------------------------------------- 175 USE wrk_nemo, ONLY: wrk_use, wrk_release176 USE wrk_nemo, ONLY: zptb => wrk_2d_1177 ! !171 USE wrk_nemo, ONLY: wrk_use, wrk_release 172 USE wrk_nemo, ONLY: zptb => wrk_2d_1 173 ! 178 174 INTEGER , INTENT(in ) :: kjpt ! number of tracers 179 175 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 180 176 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 181 ! !177 ! 182 178 INTEGER :: ji, jj, jn ! dummy loop indices 183 179 INTEGER :: ik ! local integers … … 185 181 !!---------------------------------------------------------------------- 186 182 ! 187 IF(.not. wrk_use(2,1))THEN 188 CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable') 189 RETURN 190 END IF 183 IF(.not. wrk_use(2,1) ) THEN 184 CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable') ; RETURN 185 ENDIF 191 186 ! 192 187 DO jn = 1, kjpt ! tracer loop … … 212 207 # endif 213 208 ik = mbkt(ji,jj) ! bottom T-level index 214 zbtr = e1e2t_r(ji,jj) / fse3t(ji,jj,ik)209 zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,ik) 215 210 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 216 211 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & … … 223 218 END DO ! end tracer 224 219 ! ! =========== 225 IF(.not. wrk_release(2,1))THEN 226 CALL ctl_stop('tra_bbl_dif: ERROR: failed to release workspace array') 227 END IF 220 IF(.not. wrk_release(2,1) ) CALL ctl_stop('tra_bbl_dif: failed to release workspace array') 228 221 ! 229 222 END SUBROUTINE tra_bbl_dif … … 273 266 ! 274 267 ! ! up -slope T-point (shelf bottom point) 275 zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus)268 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 276 269 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 277 270 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 278 271 ! 279 272 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 280 zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk)273 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 281 274 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 282 275 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 283 276 END DO 284 277 ! 285 zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud)278 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 286 279 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 287 280 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 295 288 ! 296 289 ! up -slope T-point (shelf bottom point) 297 zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs)290 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 298 291 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 299 292 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 300 293 ! 301 294 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 302 zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk)295 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 303 296 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 304 297 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 305 298 END DO 306 299 ! ! down-slope T-point (deep bottom point) 307 zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd)300 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 308 301 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 309 302 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 345 338 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 346 339 !!---------------------------------------------------------------------- 347 USE wrk_nemo, ONLY: wrk_use, wrk_release 348 USE wrk_nemo, ONLY: zub => wrk_2d_1, zvb => wrk_2d_2, ztb => wrk_2d_3, & 349 zsb => wrk_2d_4, zdep => wrk_2d_5 340 USE wrk_nemo, ONLY: wrk_use, wrk_release 341 USE wrk_nemo, ONLY: zub => wrk_2d_1 , ztb => wrk_2d_2 ! 2D workspace 342 USE wrk_nemo, ONLY: zvb => wrk_2d_3 , zsb => wrk_2d_4 , zdep => wrk_2d_5 343 ! 350 344 INTEGER , INTENT(in ) :: kt ! ocean time-step index 351 345 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 391 385 !!---------------------------------------------------------------------- 392 386 393 IF(.not. wrk_use(2, 1,2,3,4,5))THEN 394 CALL ctl_stop('bbl: ERROR: requested workspace arrays unavailable') 395 RETURN 396 END IF 387 IF(.not. wrk_use(2, 1,2,3,4,5) ) THEN 388 CALL ctl_stop('bbl: requested workspace arrays unavailable') ; RETURN 389 ENDIF 397 390 398 391 IF( kt == nit000 ) THEN … … 532 525 ENDIF 533 526 ! 534 IF(.not. wrk_release(2, 1,2,3,4,5))THEN 535 CALL ctl_stop('bbl: ERROR: failed to release workspace arrays') 536 END IF 527 IF(.not. wrk_release(2, 1,2,3,4,5) ) CALL ctl_stop('bbl: failed to release workspace arrays') 537 528 ! 538 529 END SUBROUTINE bbl … … 546 537 !! 547 538 !! ** Method : Read the nambbl namelist and check the parameters 548 !! called by tra_bblat the first timestep (nit000)549 !!---------------------------------------------------------------------- 550 USE wrk_nemo, ONLY: wrk_use, wrk_release551 USE wrk_nemo, ONLY: zmbk => wrk_2d_1539 !! called by nemo_init at the first timestep (nit000) 540 !!---------------------------------------------------------------------- 541 USE wrk_nemo, ONLY: wrk_use, wrk_release 542 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 ! 2D workspace 552 543 INTEGER :: ji, jj ! dummy loop indices 553 544 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer … … 556 547 !!---------------------------------------------------------------------- 557 548 558 IF(.not. wrk_use(2,1))THEN 559 CALL ctl_stop('tra_bbl_init: ERROR: requested workspace array unavailable') 560 RETURN 561 END IF 549 IF(.not. wrk_use(2,1) ) THEN 550 CALL ctl_stop('tra_bbl_init: requested workspace array unavailable') ; RETURN 551 ENDIF 562 552 563 553 REWIND ( numnam ) !* Read Namelist nambbl : bottom boundary layer scheme … … 576 566 WRITE(numout,*) ' advective bbl coefficient rn_gambbl = ', rn_gambbl, ' s' 577 567 ENDIF 578 568 569 ! ! allocate trabbl arrays 570 IF( tra_bbl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 571 579 572 IF( nn_bbl_adv == 1 ) WRITE(numout,*) ' * Advective BBL using upper velocity' 580 573 IF( nn_bbl_adv == 2 ) WRITE(numout,*) ' * Advective BBL using velocity = F( delta rho)' … … 584 577 585 578 ! !* inverse of surface of T-cells 586 e1e2t_r(:,:) = 1.0/ ( e1t(:,:) * e2t(:,:) )579 r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) ) 587 580 588 581 ! !* vertical index of "deep" bottom u- and v-points -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r2590 r2623 19 19 !! 'key_tradmp' internal damping 20 20 !!---------------------------------------------------------------------- 21 !! tra_dmp_alloc : allocate tradmp arrays 21 22 !! tra_dmp : update the tracer trend with the internal damping 22 23 !! tra_dmp_init : initialization, namlist read, parameters control … … 45 46 PUBLIC dtacof ! routine called by in both tradmp.F90 and trcdmp.F90 46 47 PUBLIC dtacof_zoom ! routine called by in both tradmp.F90 and trcdmp.F90 47 PUBLIC tra_dmp_alloc ! routine called by nemogcm.F9048 48 49 49 #if ! defined key_agrif … … 74 74 CONTAINS 75 75 76 FUNCTION tra_dmp_alloc() 77 IMPLICIT none 78 INTEGER :: tra_dmp_alloc 79 80 ALLOCATE(strdmp(jpi,jpj,jpk), ttrdmp(jpi,jpj,jpk), & 81 resto(jpi,jpj,jpk), Stat=tra_dmp_alloc) 82 83 IF(tra_dmp_alloc /= 0)THEN 84 CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed.') 85 END IF 86 76 INTEGER FUNCTION tra_dmp_alloc() 77 !!---------------------------------------------------------------------- 78 !! *** FUNCTION tra_bbl_alloc *** 79 !!---------------------------------------------------------------------- 80 ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT=tra_dmp_alloc ) 81 ! 82 IF( lk_mpp ) CALL mpp_sum ( tra_dmp_alloc ) 83 IF( tra_dmp_alloc > 0 ) CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed.') 87 84 END FUNCTION tra_dmp_alloc 85 88 86 89 87 SUBROUTINE tra_dmp( kt ) … … 207 205 ENDIF 208 206 207 ! ! allocate tradmp arrays 208 IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init : unable to allocate arrays' ) 209 209 210 SELECT CASE ( nn_hdmp ) 210 211 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only' … … 326 327 USE iom 327 328 USE ioipsl 328 USE wrk_nemo, ONLY: wrk_use, wrk_release 329 USE wrk_nemo, ONLY: zhfac => wrk_1d_1, zmrs => wrk_2d_1 330 USE wrk_nemo, ONLY: zdct => wrk_3d_1 329 USE wrk_nemo, ONLY: wrk_use, wrk_release 330 USE wrk_nemo, ONLY: zhfac => wrk_1d_1, zmrs => wrk_2d_1 , zdct => wrk_3d_1 ! 1D, 2D, 3D workspace 331 331 !! 332 332 INTEGER , INTENT(in ) :: kn_hdmp ! damping option … … 347 347 !!---------------------------------------------------------------------- 348 348 349 IF( (.not. wrk_use(1,1)) .OR. (.not. wrk_use(2,1)) .OR. & 350 (.not. wrk_use(3,1)))THEN 351 CALL ctl_stop('dtacof: ERROR: requested workspace arrays unavailable') 352 RETURN 353 END IF 349 IF( .not. wrk_use(1, 1) .OR. .not. wrk_use(2, 1) .OR. & 350 .not. wrk_use(3, 1) )THEN 351 CALL ctl_stop('dtacof: requested workspace arrays unavailable') ; RETURN 352 ENDIF 354 353 ! ! ==================== 355 354 ! ! ORCA configuration : global domain … … 544 543 ENDIF 545 544 ! 546 IF( (.not. wrk_release(1,1)) .OR. (.not. wrk_release(2,1)) .OR. & 547 (.not. wrk_release(3,1)) )THEN 548 CALL ctl_stop('dtacof: ERROR: failed to release workspace arrays') 549 END IF 545 IF( .not. wrk_release(1, 1) .OR. .not. wrk_release(2, 1) .OR. & 546 .not. wrk_release(3, 1) ) CALL ctl_stop('dtacof: failed to release workspace arrays') 550 547 ! 551 548 END SUBROUTINE dtacof … … 573 570 !!---------------------------------------------------------------------- 574 571 USE ioipsl ! IOipsl librairy 575 USE wrk_nemo, ONLY: wrk_use, wrk_release, llwrk_use, llwrk_release 576 USE wrk_nemo, ONLY: zxc => wrk_1d_1, zyc => wrk_1d_2, & 577 zzc => wrk_1d_3, zdis => wrk_1d_4 578 USE wrk_nemo, ONLY: llcotu => llwrk_2d_1, llcotv => llwrk_2d_2, & 579 llcotf => llwrk_2d_3 580 USE wrk_nemo, ONLY: zxt => wrk_2d_1, zyt => wrk_2d_2, & 581 zzt => wrk_2d_3, zmask => wrk_2d_4 572 USE wrk_nemo, ONLY: wrk_use, wrk_release, llwrk_use, llwrk_release 573 USE wrk_nemo, ONLY: zxc => wrk_1d_1, zyc => wrk_1d_2, zzc => wrk_1d_3, zdis => wrk_1d_4 574 USE wrk_nemo, ONLY: llcotu => llwrk_2d_1, llcotv => llwrk_2d_2 , llcotf => llwrk_2d_3 575 USE wrk_nemo, ONLY: zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 582 576 !! 583 577 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pdct ! distance to the coastline … … 592 586 !!---------------------------------------------------------------------- 593 587 594 IF( (.not. llwrk_use(2,1,2,3)) .OR. (.not. wrk_use(2, 1,2,3,4)) .OR. & 595 (.not. wrk_use(1, 1,2,3,4)) )THEN 596 CALL ctl_stop('cofdis: ERROR: requested workspace arrays unavailable') 597 RETURN 588 IF( .not. llwrk_use(2, 1,2,3) .OR. .not. wrk_use(2, 1,2,3,4) .OR. & 589 .not. wrk_use(1, 1,2,3,4) )THEN 590 CALL ctl_stop('cofdis: ERROR: requested workspace arrays unavailable') ; RETURN 598 591 END IF 599 592 … … 748 741 CALL restclo( icot ) 749 742 ! 750 IF( (.not. llwrk_release(2, 1,2,3)) .OR. & 751 (.not. wrk_release(2, 1,2,3,4)) .OR. & 752 (.not. wrk_release(1, 1,2,3,4)) )THEN 753 CALL ctl_stop('cofdis: ERROR: failed to release workspace arrays') 754 END IF 743 IF( .not. llwrk_release(2, 1,2,3) .OR. & 744 .not. wrk_release(2, 1,2,3,4) .OR. & 745 .not. wrk_release(1, 1,2,3,4) ) CALL ctl_stop('cofdis: failed to release workspace arrays') 755 746 ! 756 747 END SUBROUTINE cofdis -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r2590 r2623 35 35 PUBLIC tra_ldf ! called by step.F90 36 36 PUBLIC tra_ldf_init ! called by opa.F90 37 PUBLIC tra_ldf_alloc ! called by nemogcm.F9038 37 ! 39 38 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 40 #if defined key_traldf_ano 41 REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: t0_ldf, s0_ldf ! lateral diffusion trends of T & S for a constant profile42 #endif 39 40 REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: t0_ldf, s0_ldf !: lateral diffusion trends of T & S for a cst profile 41 ! ! (key_traldf_ano only) 43 42 44 43 !! * Substitutions … … 51 50 !!---------------------------------------------------------------------- 52 51 CONTAINS 53 54 FUNCTION tra_ldf_alloc()55 IMPLICIT none56 INTEGER :: tra_ldf_alloc57 58 tra_ldf_alloc = 059 60 #if defined key_traldf_ano61 ALLOCATE(t0_ldf(jpi,jpj,jpk), s0_ldf(jpi,jpj,jpk), Stat=tra_ldf_alloc)62 #endif63 64 IF(tra_ldf_alloc /= 0)THEN65 CALL ctl_warn('tra_ldf_alloc: failed to allocate arrays t0_ldf and s0_ldf.')66 END IF67 68 END FUNCTION tra_ldf_alloc69 52 70 53 SUBROUTINE tra_ldf( kt ) … … 147 130 !!---------------------------------------------------------------------- 148 131 INTEGER :: ioptio, ierr ! temporary integers 149 !150 132 !!---------------------------------------------------------------------- 151 133 … … 256 238 !!---------------------------------------------------------------------- 257 239 USE wrk_nemo, ONLY: wrk_use, wrk_release 258 USE wrk_nemo, ONLY: zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3 259 USE wrk_nemo, ONLY: zs_ref => wrk_3d_4, zsb => wrk_3d_5 ! 3D workspaces240 USE wrk_nemo, ONLY: zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3 ! 3D workspaces 241 USE wrk_nemo, ONLY: zs_ref => wrk_3d_4, zsb => wrk_3d_5 ! 3D workspaces 260 242 !! 261 243 USE zdf_oce ! vertical mixing … … 264 246 !! 265 247 INTEGER :: jk ! Dummy loop indice 248 INTEGER :: ierr ! local integer 266 249 LOGICAL :: llsave ! 267 REAL(wp) :: zt0, zs0, z12 ! temporary scalar 268 !!---------------------------------------------------------------------- 269 270 IF(.NOT. wrk_use(3, 1,2,3,4,5))THEN 271 CALL ctl_stop('ldf_ano : requested workspace arrays unavailable.') 272 RETURN 273 END IF 250 REAL(wp) :: zt0, zs0, z12 ! local scalar 251 !!---------------------------------------------------------------------- 252 253 IF(.NOT. wrk_use(3, 1,2,3,4,5) ) THEN 254 CALL ctl_stop('ldf_ano : requested workspace arrays unavailable') ; RETURN 255 ENDIF 274 256 275 257 IF(lwp) THEN … … 278 260 WRITE(numout,*) '~~~~~~~~~~~' 279 261 ENDIF 262 263 ! ! allocate trabbl arrays 264 ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr ) 265 IF( lk_mpp ) CALL ctl_warn( ierr ) 266 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_ano : unable to allocate arrays' ) 280 267 281 268 ! defined the T & S reference profiles … … 333 320 avt(:,:,:) = zavt(:,:,:) 334 321 ! 335 IF(.NOT. wrk_release(3, 1,2,3,4,5))THEN 336 CALL ctl_stop('ldf_ano : failed to release workspace arrays.') 337 END IF 322 IF(.NOT. wrk_release(3, 1,2,3,4,5) ) CALL ctl_stop('ldf_ano : failed to release workspace arrays') 338 323 ! 339 324 END SUBROUTINE ldf_ano -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r2613 r2623 16 16 USE oce ! ocean dynamics and active tracers 17 17 USE dom_oce ! ocean space and time domain 18 USE phycst ! physical constants 18 19 USE trc_oce ! share passive tracers/Ocean variables 19 20 USE zdf_oce ! ocean vertical physics … … 23 24 USE in_out_manager ! I/O manager 24 25 USE iom ! I/O library 25 #if defined key_diaar526 USE phycst ! physical constants27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 #endif29 27 30 28 IMPLICIT NONE 31 29 PRIVATE 32 30 33 PUBLIC tra_ldf_iso_grif ! routine called by traldf.F90 34 PUBLIC tra_ldf_iso_grif_alloc ! routine called by nemogcm.F90 35 36 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: psix_eiv 37 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: psiy_eiv 38 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: ah_wslp2 39 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt ! 2D+1 workspace 31 PUBLIC tra_ldf_iso_grif ! routine called by traldf.F90 32 33 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: psix_eiv, psiy_eiv !: eiv stream function (diag only) 34 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ah_wslp2 !: aeiv*w-slope^2 35 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt ! atypic workspace 40 36 41 37 !! * Substitutions … … 50 46 !!---------------------------------------------------------------------- 51 47 CONTAINS 52 53 FUNCTION tra_ldf_iso_grif_alloc()54 !!----------------------------------------------------------------------55 !! *** ROUTINE tra_ldf_iso_grif_alloc ***56 !!----------------------------------------------------------------------57 INTEGER :: tra_ldf_iso_grif_alloc58 !!----------------------------------------------------------------------59 !60 ALLOCATE(zdkt(jpi,jpj,0:1), Stat=tra_ldf_iso_grif_alloc)61 !62 IF( tra_ldf_iso_grif_alloc /= 0 ) CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.')63 !64 END FUNCTION tra_ldf_iso_grif_alloc65 66 48 67 49 SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv, & … … 106 88 !! ** Action : Update pta arrays with the before rotated diffusion 107 89 !!---------------------------------------------------------------------- 108 USE oce, zftu => ua ! use ua as workspace 109 USE oce, zftv => va ! use va as workspace 110 USE wrk_nemo, ONLY: wrk_use, wrk_release 111 USE wrk_nemo, ONLY: zdit => wrk_3d_1, zdjt => wrk_3d_2, ztfw => wrk_3d_3 112 !USE wrk_nemo, ONLY: wrk_3d_4 ! For 2D+1 workspace 113 USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! Only used if key_diaar5 defined 90 USE wrk_nemo, ONLY: wrk_use, wrk_release 91 USE oce , ONLY: zftu => ua , zftv => va ! (ua,va) used as 3D workspace 92 USE wrk_nemo, ONLY: zdit => wrk_3d_1 , zdjt => wrk_3d_2 , ztfw => wrk_3d_3 ! 3D workspace 93 USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! 2D workspace 114 94 !! 115 95 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 137 117 !!---------------------------------------------------------------------- 138 118 139 ! Check that workspace arrays are free for use 140 IF( (.NOT. wrk_use(3, 1,2,3)) .OR. (.NOT. wrk_use(2, 1)))THEN 141 CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.') 142 RETURN 143 END IF 119 IF( .NOT. wrk_use(3, 1,2,3) .OR. .NOT. wrk_use(2, 1) ) THEN 120 CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.') ; RETURN 121 ENDIF 144 122 ! ARP - line below uses 'bounds re-mapping' which is only defined in 145 123 ! Fortran 2003 and up. We would be OK if code was written to use … … 153 131 IF(lwp) WRITE(numout,*) ' WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL' 154 132 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 155 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , STAT=ierr ) 156 IF( ierr > 0 ) THEN 157 CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator ah_wslp2 ' ) ; RETURN 158 ENDIF 133 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr ) 134 IF( lk_mpp ) CALL mpp_sum ( ierr ) 135 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 159 136 IF( ln_traldf_gdia ) THEN 160 137 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 161 IF( ierr > 0 ) THEN 162 CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator diagnostics ' ) ; RETURN 163 ENDIF 138 IF( lk_mpp ) CALL mpp_sum ( ierr ) 139 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 164 140 ENDIF 165 141 ENDIF -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2590 r2623 28 28 PRIVATE 29 29 30 PUBLIC tra_ldf_lap ! routine called by step.F90 31 PUBLIC tra_ldf_lap_alloc ! routine called by nemogcm.F90 30 PUBLIC tra_ldf_lap ! routine called by step.F90 32 31 33 32 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: e1ur, e2vr ! scale factor coefficients … … 43 42 !!---------------------------------------------------------------------- 44 43 CONTAINS 45 46 FUNCTION tra_ldf_lap_alloc()47 !!----------------------------------------------------------------------48 !! *** ROUTINE tra_ldf_lap_alloc ***49 !!----------------------------------------------------------------------50 IMPLICIT none51 INTEGER :: tra_ldf_lap_alloc52 !!----------------------------------------------------------------------53 54 ALLOCATE(e1ur(jpi,jpj), e2vr(jpi,jpj), Stat=tra_ldf_lap_alloc)55 56 IF( tra_ldf_lap_alloc /= 0)THEN57 CALL ctl_warn('tra_ldf_lap_alloc: failed to allocate e1ur and e2vr arrays.')58 END IF59 60 END FUNCTION tra_ldf_lap_alloc61 44 62 45 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, & … … 79 62 !! harmonic mixing trend. 80 63 !!---------------------------------------------------------------------- 81 USE oce ,ztu => ua ! use ua as workspace82 USE oce ,ztv => va ! use va as workspace64 USE oce , ztu => ua ! use ua as workspace 65 USE oce , ztv => va ! use va as workspace 83 66 !! 84 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 90 73 !! 91 74 INTEGER :: ji, jj, jk, jn ! dummy loop indices 92 INTEGER :: iku, ikv 75 INTEGER :: iku, ikv, ierr ! local integers 93 76 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars 94 77 !!---------------------------------------------------------------------- … … 98 81 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 99 82 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 83 ! 84 ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 85 IF( lk_mpp ) CALL mpp_sum( ierr ) 86 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 87 ! 100 88 e1ur(:,:) = e2u(:,:) / e1u(:,:) 101 89 e2vr(:,:) = e1v(:,:) / e2v(:,:) … … 140 128 DO jj = 2, jpjm1 141 129 DO ji = fs_2, fs_jpim1 ! vector opt. 142 zbtr = 1. 0 / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )130 zbtr = 1._wp / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) ) 143 131 ! horizontal diffusive trends added to the general tracer trends 144 132 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r2590 r2623 55 55 PUBLIC tra_nxt_fix ! to be used in trcnxt 56 56 PUBLIC tra_nxt_vvl ! to be used in trcnxt 57 PUBLIC tra_nxt_alloc ! used in nemogcm.F90 58 59 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg 60 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 57 58 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg 61 59 62 60 !! * Substitutions … … 64 62 !!---------------------------------------------------------------------- 65 63 !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 66 !! $Id 67 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)64 !! $Id$ 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 68 66 !!---------------------------------------------------------------------- 69 67 CONTAINS 70 71 FUNCTION tra_nxt_alloc()72 !!----------------------------------------------------------------------73 !! *** ROUTINE tran_xt_alloc ***74 !!----------------------------------------------------------------------75 IMPLICIT none76 INTEGER tra_nxt_alloc77 !!----------------------------------------------------------------------78 79 ALLOCATE(r2dt(jpk), Stat=tra_nxt_alloc)80 81 IF(tra_nxt_alloc /= 0)THEN82 CALL ctl_warn('tra_nxt_alloc: failed to allocate array r2dt.')83 END IF84 85 END FUNCTION tra_nxt_alloc86 68 87 69 SUBROUTINE tra_nxt( kt ) … … 121 103 IF(lwp) WRITE(numout,*) '~~~~~~~' 122 104 ! 123 rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)! Brown & Campana parameter for semi-implicit hpg105 rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp) ! Brown & Campana parameter for semi-implicit hpg 124 106 ENDIF 125 107 … … 148 130 149 131 ! set time step size (Euler/Leapfrog) 150 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt (:) = rdttra(:) ! at nit000 (Euler)151 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt (:) = 2.* rdttra(:) ! at nit000 or nit000+1 (Leapfrog)132 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dtra(:) = rdttra(:) ! at nit000 (Euler) 133 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2.* rdttra(:) ! at nit000 or nit000+1 (Leapfrog) 152 134 ENDIF 153 135 … … 181 163 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 182 164 DO jk = 1, jpkm1 183 zfact = 1.e0 / r2dt (jk)165 zfact = 1.e0 / r2dtra(jk) 184 166 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 185 167 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r2590 r2623 34 34 PRIVATE 35 35 36 PUBLIC tra_zdf ! routine called by step.F90 37 PUBLIC tra_zdf_init ! routine called by opa.F90 38 PUBLIC tra_zdf_alloc! routine called by nemogcm.F90 36 PUBLIC tra_zdf ! routine called by step.F90 37 PUBLIC tra_zdf_init ! routine called by nemogcm.F90 39 38 40 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 41 ! ! defined from ln_zdf... namlist logicals) 42 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 43 ! ! except at nit000 (=rdttra) if neuler=0 39 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used (defined from ln_zdf... namlist logicals) 44 40 45 41 !! * Substitutions … … 50 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 51 47 !! $Id$ 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 49 !!---------------------------------------------------------------------- 54 55 50 CONTAINS 56 57 FUNCTION tra_zdf_alloc()58 !!----------------------------------------------------------------------59 !! *** ROUTINE tra_zdf_alloc ***60 !!----------------------------------------------------------------------61 IMPLICIT none62 INTEGER :: tra_zdf_alloc63 !!----------------------------------------------------------------------64 65 ALLOCATE(r2dt(jpk), Stat=tra_zdf_alloc)66 67 IF(tra_zdf_alloc /= 0)THEN68 CALL ctl_warn('tra_zdf_alloc: failed to allocate r2dt array')69 END IF70 71 END FUNCTION tra_zdf_alloc72 51 73 52 SUBROUTINE tra_zdf( kt ) … … 85 64 ! ! set time step 86 65 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 87 r2dt (:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)66 r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping) 88 67 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 89 r2dt (:) = 2. * rdttra(:) ! = 2 rdttra (leapfrog)68 r2dtra(:) = 2. * rdttra(:) ! = 2 rdttra (leapfrog) 90 69 ENDIF 91 70 … … 96 75 97 76 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 98 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRA', r2dt , nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme99 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRA', r2dt , tsb, tsa, jpts ) ! implicit scheme77 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme 78 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRA', r2dtra, tsb, tsa, jpts ) ! implicit scheme 100 79 CASE ( -1 ) ! esopa: test all possibility with control print 101 CALL tra_zdf_exp( kt, 'TRA', r2dt , nn_zdfexp, tsb, tsa, jpts )80 CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 102 81 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 103 82 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 104 CALL tra_zdf_imp( kt, 'TRA', r2dt , tsb, tsa, jpts )83 CALL tra_zdf_imp( kt, 'TRA', r2dtra, tsb, tsa, jpts ) 105 84 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 106 85 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 109 88 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 110 89 DO jk = 1, jpkm1 111 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt (jk) ) - ztrdt(:,:,jk)112 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt (jk) ) - ztrds(:,:,jk)90 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 91 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 113 92 END DO 114 93 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) … … 120 99 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf - Ta: ', mask1=tmask, & 121 100 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 122 101 ! 123 102 END SUBROUTINE tra_zdf 124 103 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r2616 r2623 97 97 !!---------------------------------------------------------------------- 98 98 99 IF(.NOT. wrk_use(2, 1))THEN 100 CALL ctl_stop('zdf_ric : requested workspace array unavailable.') 101 RETURN 99 IF(.NOT. wrk_use(2, 1) ) THEN 100 CALL ctl_stop('zdf_ric : requested workspace array unavailable') ; RETURN 102 101 END IF 103 102 ! ! =============== … … 151 150 CALL lbc_lnk( avmu, 'U', 1. ) ; CALL lbc_lnk( avmv, 'V', 1. ) 152 151 ! 153 IF(.NOT. wrk_release(2, 1))THEN 154 CALL ctl_stop('zdf_ric : failed to release workspace array.') 155 END IF 152 IF(.NOT. wrk_release(2, 1) ) CALL ctl_stop('zdf_ric : failed to release workspace array') 156 153 ! 157 154 END SUBROUTINE zdf_ric -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2622 r2623 479 479 #endif 480 480 481 USE traadv, ONLY: tra_adv_alloc482 USE traadv_cen2, ONLY: tra_adv_cen2_alloc483 #if defined key_trabbl || defined key_esopa484 USE trabbl, ONLY: tra_bbl_alloc485 #endif486 #if defined key_tradmp || defined key_esopa487 USE tradmp, ONLY: tra_dmp_alloc488 #endif489 USE traldf, ONLY: tra_ldf_alloc490 #if defined key_ldfslp || defined key_esopa491 USE traldf_iso_grif,ONLY: tra_ldf_iso_grif_alloc492 #endif493 USE traldf_lap, ONLY: tra_ldf_lap_alloc494 USE tranxt, ONLY: tra_nxt_alloc495 USE trazdf, ONLY: tra_zdf_alloc496 497 481 ! TOP-related alloc routines... 498 482 #if defined key_top … … 559 543 ierr = ierr + obc_oce_alloc() 560 544 #endif 561 562 ierr = ierr + tra_adv_alloc()563 ierr = ierr + tra_adv_cen2_alloc()564 #if defined key_trabbl || defined key_esopa565 ierr = ierr + tra_bbl_alloc()566 #endif567 #if defined key_tradmp || defined key_esopa568 ierr = ierr + tra_dmp_alloc()569 #endif570 ierr = ierr + tra_ldf_alloc()571 #if defined key_ldfslp || defined key_esopa572 ierr = ierr + tra_ldf_iso_grif_alloc()573 #endif574 ierr = ierr + tra_ldf_lap_alloc()575 ierr = ierr + tra_nxt_alloc()576 ierr = ierr + tra_zdf_alloc()577 545 578 546 ! Start of TOP-related alloc routines...
Note: See TracChangeset
for help on using the changeset viewer.