Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r2528 r2715 21 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 22 USE prtctl ! Print control 23 USE lib_mpp ! MPP library 23 24 24 25 IMPLICIT NONE … … 27 28 PUBLIC zdf_ddm ! called by step.F90 28 29 PUBLIC zdf_ddm_init ! called by opa.F90 30 PUBLIC zdf_ddm_alloc ! called by nemogcm.F90 29 31 30 32 LOGICAL , PUBLIC, PARAMETER :: lk_zdfddm = .TRUE. !: double diffusive mixing flag 31 33 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: avs !: salinity vertical diffusivity coeff. at w-point33 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rrau !: heat/salt buoyancy flux ratio34 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avs !: salinity vertical diffusivity coeff. at w-point 35 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rrau !: heat/salt buoyancy flux ratio 34 36 35 37 ! !!* Namelist namzdf_ddm : double diffusive mixing * … … 40 42 # include "vectopt_loop_substitute.h90" 41 43 !!---------------------------------------------------------------------- 42 !! NEMO/OPA 3.3 , NEMO Consortium (2010)44 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 43 45 !! $Id$ 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 !!---------------------------------------------------------------------- 46 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 !!---------------------------------------------------------------------- 47 48 CONTAINS 49 50 INTEGER FUNCTION zdf_ddm_alloc() 51 !!---------------------------------------------------------------------- 52 !! *** ROUTINE zdf_ddm_alloc *** 53 !!---------------------------------------------------------------------- 54 ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT= zdf_ddm_alloc ) 55 ! 56 IF( lk_mpp ) CALL mpp_sum ( zdf_ddm_alloc ) 57 IF( zdf_ddm_alloc /= 0 ) CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays') 58 END FUNCTION zdf_ddm_alloc 59 48 60 49 61 SUBROUTINE zdf_ddm( kt ) … … 79 91 !! References : Merryfield et al., JPO, 29, 1124-1142, 1999. 80 92 !!---------------------------------------------------------------------- 93 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 94 USE wrk_nemo, ONLY: zmsks => wrk_2d_1 , zmskf => wrk_2d_2 , zmskd1 => wrk_2d_3 ! 2D workspace 95 USE wrk_nemo, ONLY: zmskd2 => wrk_2d_4 , zmskd3 => wrk_2d_5 ! - - 96 ! 81 97 INTEGER, INTENT(in) :: kt ! ocean time-step indexocean time step 82 ! !98 ! 83 99 INTEGER :: ji, jj , jk ! dummy loop indices 84 100 REAL(wp) :: zinr, zrr ! temporary scalars 85 101 REAL(wp) :: zavft, zavfs ! - - 86 102 REAL(wp) :: zavdt, zavds ! - - 87 REAL(wp), DIMENSION(jpi,jpj) :: zmsks, zmskf, zmskd1, zmskd2, zmskd3 ! 2D workspace 88 !!---------------------------------------------------------------------- 103 !!---------------------------------------------------------------------- 104 105 IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 106 CALL ctl_stop('zdf_ddm: Requested workspace arrays already in use') ; RETURN 107 ENDIF 89 108 90 109 ! ! =============== … … 98 117 DO ji = 1, jpi 99 118 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 100 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0. e0101 ELSE ; zmsks(ji,jj) = 1. e0119 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp 120 ELSE ; zmsks(ji,jj) = 1._wp 102 121 ENDIF 103 122 ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere 104 IF( rrau(ji,jj,jk) <= 1. ) THEN ; zmskf(ji,jj) = 0. e0105 ELSE ; zmskf(ji,jj) = 1. e0123 IF( rrau(ji,jj,jk) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 124 ELSE ; zmskf(ji,jj) = 1._wp 106 125 ENDIF 107 126 ! diffusive layering indicators: 108 127 ! ! mskdl1=1 if 0<rrau<1; 0 elsewhere 109 IF( rrau(ji,jj,jk) >= 1. ) THEN ; zmskd1(ji,jj) = 0. e0110 ELSE ; zmskd1(ji,jj) = 1. e0128 IF( rrau(ji,jj,jk) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 129 ELSE ; zmskd1(ji,jj) = 1._wp 111 130 ENDIF 112 131 ! ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 113 IF( rrau(ji,jj,jk) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0. e0114 ELSE ; zmskd2(ji,jj) = 1. e0132 IF( rrau(ji,jj,jk) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 133 ELSE ; zmskd2(ji,jj) = 1._wp 115 134 ENDIF 116 135 ! mskdl3=1 if 0.5<rrau<1; 0 elsewhere 117 IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN ; zmskd3(ji,jj) = 0. e0118 ELSE ; zmskd3(ji,jj) = 1. e0136 IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 137 ELSE ; zmskd3(ji,jj) = 1._wp 119 138 ENDIF 120 139 END DO … … 166 185 ! ! =============== 167 186 ! 168 CALL lbc_lnk( avt , 'W', 1. )! Lateral boundary conditions (unchanged sign)169 CALL lbc_lnk( avs , 'W', 1. )170 CALL lbc_lnk( avm , 'W', 1. )171 CALL lbc_lnk( avmu, 'U', 1. )172 CALL lbc_lnk( avmv, 'V', 1. )187 CALL lbc_lnk( avt , 'W', 1._wp ) ! Lateral boundary conditions (unchanged sign) 188 CALL lbc_lnk( avs , 'W', 1._wp ) 189 CALL lbc_lnk( avm , 'W', 1._wp ) 190 CALL lbc_lnk( avmu, 'U', 1._wp ) 191 CALL lbc_lnk( avmv, 'V', 1._wp ) 173 192 174 193 IF(ln_ctl) THEN … … 178 197 ENDIF 179 198 ! 199 IF( wrk_not_released(2, 1,2,3,4,5) ) CALL ctl_stop('zdf_ddm: Release of workspace arrays failed') 200 ! 180 201 END SUBROUTINE zdf_ddm 181 202 … … 193 214 !!---------------------------------------------------------------------- 194 215 ! 195 REWIND ( numnam )! Read Namelist namzdf_ddm : double diffusion mixing scheme196 READ 216 REWIND( numnam ) ! Read Namelist namzdf_ddm : double diffusion mixing scheme 217 READ ( numnam, namzdf_ddm ) 197 218 ! 198 219 IF(lwp) THEN ! Parameter print … … 203 224 WRITE(numout,*) ' maximum avs for dd mixing rn_avts = ', rn_avts 204 225 WRITE(numout,*) ' heat/salt buoyancy flux ratio rn_hsbfr = ', rn_hsbfr 205 WRITE(numout,*)206 226 ENDIF 227 ! 228 ! ! allocate zdfddm arrays 229 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 207 230 ! 208 231 END SUBROUTINE zdf_ddm_init
Note: See TracChangeset
for help on using the changeset viewer.
