- Timestamp:
- 2017-06-25T12:26:32+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 3 edited
-
dia25h.F90 (modified) (8 diffs)
-
diaar5.F90 (modified) (2 diffs)
-
diawri.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r7753 r8215 8 8 USE oce ! ocean dynamics and tracers variables 9 9 USE dom_oce ! ocean space and time domain 10 USE zdf_oce ! ocean vertical physics 11 USE zdfgls , ONLY : hmxl_n 10 12 USE in_out_manager ! I/O units 11 13 USE iom ! I/0 library 12 USE wrk_nemo ! working arrays 13 #if defined key_zdftke 14 USE zdf_oce, ONLY: en 15 #endif 16 USE zdf_oce, ONLY: avt, avm 17 #if defined key_zdfgls 18 USE zdf_oce, ONLY: en 19 USE zdfgls, ONLY: mxln 20 #endif 14 USE wrk_nemo ! work arrays 21 15 22 16 IMPLICIT NONE 23 17 PRIVATE 24 18 25 LOGICAL , PUBLIC :: ln_dia25h !: 25h mean output26 19 PUBLIC dia_25h_init ! routine called by nemogcm.F90 27 20 PUBLIC dia_25h ! routine called by diawri.F90 28 21 29 !! * variables for calculating 25-hourly means 30 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_25h , sn_25h 31 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:) :: sshn_25h 32 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: un_25h , vn_25h , wn_25h 33 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avt_25h , avm_25h 34 #if defined key_zdfgls || key_zdftke 35 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: en_25h 36 #endif 37 #if defined key_zdfgls 38 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rmxln_25h 39 #endif 40 INTEGER, SAVE :: cnt_25h ! Counter for 25 hour means 41 42 22 LOGICAL, PUBLIC :: ln_dia25h !: 25h mean output 23 24 ! variables for calculating 25-hourly means 25 INTEGER , SAVE :: cnt_25h ! Counter for 25 hour means 26 REAL(wp), SAVE :: r1_25 = 0.04_wp ! =1/25 27 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_25h , sn_25h 28 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: sshn_25h 29 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: un_25h , vn_25h , wn_25h 30 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avt_25h , avm_25h 31 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: en_25h , rmxln_25h 43 32 44 33 !!---------------------------------------------------------------------- … … 56 45 !! 57 46 !! ** Method : Read namelist 58 !! History59 !! 3.6 ! 08-14 (E. O'Dea) Routine to initialize dia_25h60 47 !!--------------------------------------------------------------------------- 61 !!62 48 INTEGER :: ios ! Local integer output status for namelist read 63 49 INTEGER :: ierror ! Local integer for memory allocation … … 79 65 WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics' 80 66 WRITE(numout,*) '~~~~~~~~~~~~' 81 WRITE(numout,*) ' Namelist nam_dia25h : set 25h outputs '82 WRITE(numout,*) ' Switch for 25h diagnostics (T) or not (F) ln_dia25h = ', ln_dia25h67 WRITE(numout,*) ' Namelist nam_dia25h : set 25h outputs ' 68 WRITE(numout,*) ' Switch for 25h diagnostics (T) or not (F) ln_dia25h = ', ln_dia25h 83 69 ENDIF 84 70 IF( .NOT. ln_dia25h ) RETURN … … 86 72 ! 1 - Allocate memory ! 87 73 ! ------------------- ! 88 ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror ) 74 ! ! ocean arrays 75 ALLOCATE( tn_25h (jpi,jpj,jpk), sn_25h (jpi,jpj,jpk), sshn_25h(jpi,jpj) , & 76 & un_25h (jpi,jpj,jpk), vn_25h (jpi,jpj,jpk), wn_25h(jpi,jpj,jpk), & 77 & avt_25h(jpi,jpj,jpk), avm_25h(jpi,jpj,jpk), STAT=ierror ) 89 78 IF( ierror > 0 ) THEN 90 CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' ) ; RETURN 91 ENDIF 92 ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror ) 93 IF( ierror > 0 ) THEN 94 CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' ) ; RETURN 95 ENDIF 96 ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror ) 97 IF( ierror > 0 ) THEN 98 CALL ctl_stop( 'dia_25h: unable to allocate un_25h' ) ; RETURN 99 ENDIF 100 ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror ) 101 IF( ierror > 0 ) THEN 102 CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' ) ; RETURN 103 ENDIF 104 ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror ) 105 IF( ierror > 0 ) THEN 106 CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' ) ; RETURN 107 ENDIF 108 ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror ) 109 IF( ierror > 0 ) THEN 110 CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' ) ; RETURN 111 ENDIF 112 ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror ) 113 IF( ierror > 0 ) THEN 114 CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' ) ; RETURN 115 ENDIF 116 # if defined key_zdfgls || defined key_zdftke 117 ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror ) 118 IF( ierror > 0 ) THEN 119 CALL ctl_stop( 'dia_25h: unable to allocate en_25h' ) ; RETURN 120 ENDIF 121 #endif 122 # if defined key_zdfgls 123 ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror ) 124 IF( ierror > 0 ) THEN 125 CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' ) ; RETURN 126 ENDIF 127 #endif 128 ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror ) 129 IF( ierror > 0 ) THEN 130 CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' ) ; RETURN 79 CALL ctl_stop( 'dia_25h: unable to allocate ocean arrays' ) ; RETURN 80 ENDIF 81 IF( ln_zdftke ) THEN ! TKE physics 82 ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror ) 83 IF( ierror > 0 ) THEN 84 CALL ctl_stop( 'dia_25h: unable to allocate en_25h' ) ; RETURN 85 ENDIF 86 ENDIF 87 IF( ln_zdfgls ) THEN ! GLS physics 88 ALLOCATE( en_25h(jpi,jpj,jpk), rmxln_25h(jpi,jpj,jpk), STAT=ierror ) 89 IF( ierror > 0 ) THEN 90 CALL ctl_stop( 'dia_25h: unable to allocate en_25h and rmxln_25h' ) ; RETURN 91 ENDIF 131 92 ENDIF 132 93 ! ------------------------- ! … … 134 95 ! ------------------------- ! 135 96 cnt_25h = 1 ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 136 tn_25h (:,:,:) = tsb(:,:,:,jp_tem)137 sn_25h (:,:,:) = tsb(:,:,:,jp_sal)138 sshn_25h(:,:) = sshb(:,:)139 un_25h (:,:,:) = ub(:,:,:)140 vn_25h (:,:,:) = vb(:,:,:)141 wn_25h (:,:,:) = wn(:,:,:)142 avt_25h (:,:,:) = avt(:,:,:)143 avm_25h (:,:,:) = avm(:,:,:)144 # if defined key_zdfgls || defined key_zdftke 97 tn_25h (:,:,:) = tsb (:,:,:,jp_tem) 98 sn_25h (:,:,:) = tsb (:,:,:,jp_sal) 99 sshn_25h(:,:) = sshb(:,:) 100 un_25h (:,:,:) = ub (:,:,:) 101 vn_25h (:,:,:) = vb (:,:,:) 102 wn_25h (:,:,:) = wn (:,:,:) 103 avt_25h (:,:,:) = avt (:,:,:) 104 avm_25h (:,:,:) = avm (:,:,:) 105 IF( ln_zdftke ) THEN 145 106 en_25h(:,:,:) = en(:,:,:) 146 #endif 147 # if defined key_zdfgls 148 rmxln_25h(:,:,:) = mxln(:,:,:) 149 #endif 107 ENDIF 108 IF( ln_zdfgls ) THEN 109 en_25h (:,:,:) = en (:,:,:) 110 rmxln_25h(:,:,:) = hmxl_n(:,:,:) 111 ENDIF 150 112 #if defined key_lim3 || defined key_lim2 151 113 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 152 114 #endif 153 154 ! -------------------------- ! 155 ! 3 - Return to dia_wri ! 156 ! -------------------------- ! 157 158 115 ! 159 116 END SUBROUTINE dia_25h_init 160 117 … … 164 121 !! *** ROUTINE dia_25h *** 165 122 !! 166 !!167 !!--------------------------------------------------------------------168 !!169 123 !! ** Purpose : Write diagnostics with M2/S2 tide removed 170 124 !! 171 !! ** Method : 172 !! 25hr mean outputs for shelf seas 125 !! ** Method : 25hr mean outputs for shelf seas 126 !!---------------------------------------------------------------------- 127 INTEGER, INTENT(in) :: kt ! ocean time-step index 173 128 !! 174 !! History :175 !! ?.0 ! 07-04 (A. Hines) New routine, developed from dia_wri_foam176 !! 3.4 ! 02-13 (J. Siddorn) Routine taken from old dia_wri_foam177 !! 3.6 ! 08-14 (E. O'Dea) adapted for VN3.6178 !!----------------------------------------------------------------------179 !! * Modules used180 181 IMPLICIT NONE182 183 !! * Arguments184 INTEGER, INTENT( in ) :: kt ! ocean time-step index185 186 187 !! * Local declarations188 129 INTEGER :: ji, jj, jk 189 130 INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day 190 131 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout 191 REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! temporary reals 192 INTEGER :: i_steps ! no of timesteps per hour 193 REAL(wp), DIMENSION(jpi,jpj ) :: zw2d, un_dm, vn_dm ! temporary workspace 194 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! temporary workspace 195 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! temporary workspace 196 INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day 197 132 REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! local scalars 133 INTEGER :: i_steps ! no of timesteps per hour 134 REAL(wp), DIMENSION(jpi,jpj ) :: zw2d, un_dm, vn_dm ! workspace 135 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! workspace 136 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! workspace 198 137 !!---------------------------------------------------------------------- 199 138 … … 207 146 ENDIF 208 147 209 #if defined key_lim3 || defined key_lim2210 CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')211 #endif212 213 148 ! local variable for debugging 214 149 ll_print = ll_print .AND. lwp 215 150 216 ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours 217 ! every day 218 IF( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 ) THEN 151 ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours every day 152 IF( MOD( kt, i_steps ) == 0 .AND. kt /= nn_it000 ) THEN 219 153 220 154 IF (lwp) THEN … … 223 157 ENDIF 224 158 225 tn_25h(:,:,:) = tn_25h(:,:,:) + tsn(:,:,:,jp_tem) 226 sn_25h(:,:,:) = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 227 sshn_25h(:,:) = sshn_25h(:,:) + sshn (:,:) 228 un_25h(:,:,:) = un_25h(:,:,:) + un(:,:,:) 229 vn_25h(:,:,:) = vn_25h(:,:,:) + vn(:,:,:) 230 wn_25h(:,:,:) = wn_25h(:,:,:) + wn(:,:,:) 231 avt_25h(:,:,:) = avt_25h(:,:,:) + avt(:,:,:) 232 avm_25h(:,:,:) = avm_25h(:,:,:) + avm(:,:,:) 233 # if defined key_zdfgls || defined key_zdftke 234 en_25h(:,:,:) = en_25h(:,:,:) + en(:,:,:) 235 #endif 236 # if defined key_zdfgls 237 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 238 #endif 159 tn_25h (:,:,:) = tn_25h (:,:,:) + tsn (:,:,:,jp_tem) 160 sn_25h (:,:,:) = sn_25h (:,:,:) + tsn (:,:,:,jp_sal) 161 sshn_25h(:,:) = sshn_25h(:,:) + sshn(:,:) 162 un_25h (:,:,:) = un_25h (:,:,:) + un (:,:,:) 163 vn_25h (:,:,:) = vn_25h (:,:,:) + vn (:,:,:) 164 wn_25h (:,:,:) = wn_25h (:,:,:) + wn (:,:,:) 165 avt_25h (:,:,:) = avt_25h (:,:,:) + avt (:,:,:) 166 avm_25h (:,:,:) = avm_25h (:,:,:) + avm (:,:,:) 167 IF( ln_zdftke ) THEN 168 en_25h(:,:,:) = en_25h (:,:,:) + en(:,:,:) 169 ENDIF 170 IF( ln_zdfgls ) THEN 171 en_25h (:,:,:) = en_25h (:,:,:) + en (:,:,:) 172 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + hmxl_n(:,:,:) 173 ENDIF 239 174 cnt_25h = cnt_25h + 1 240 175 ! 241 176 IF (lwp) THEN 242 177 WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h 243 178 ENDIF 244 179 ! 245 180 ENDIF ! MOD( kt, i_steps ) == 0 246 181 247 ! Write data for 25 hour mean output streams 248 IF( cnt_25h .EQ. 25 .AND. MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN 249 250 IF(lwp) THEN 251 WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt 252 WRITE(numout,*) '~~~~~~~~~~~~ ' 253 ENDIF 254 255 tn_25h(:,:,:) = tn_25h(:,:,:) / 25.0_wp 256 sn_25h(:,:,:) = sn_25h(:,:,:) / 25.0_wp 257 sshn_25h(:,:) = sshn_25h(:,:) / 25.0_wp 258 un_25h(:,:,:) = un_25h(:,:,:) / 25.0_wp 259 vn_25h(:,:,:) = vn_25h(:,:,:) / 25.0_wp 260 wn_25h(:,:,:) = wn_25h(:,:,:) / 25.0_wp 261 avt_25h(:,:,:) = avt_25h(:,:,:) / 25.0_wp 262 avm_25h(:,:,:) = avm_25h(:,:,:) / 25.0_wp 263 # if defined key_zdfgls || defined key_zdftke 264 en_25h(:,:,:) = en_25h(:,:,:) / 25.0_wp 265 #endif 266 # if defined key_zdfgls 267 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 268 #endif 269 270 IF (lwp) WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 271 zmdi=1.e+20 !missing data indicator for masking 272 ! write tracers (instantaneous) 273 zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 274 CALL iom_put("temper25h", zw3d) ! potential temperature 275 zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 276 CALL iom_put( "salin25h", zw3d ) ! salinity 277 zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 278 CALL iom_put( "ssh25h", zw2d ) ! sea surface 279 280 281 ! Write velocities (instantaneous) 282 zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 283 CALL iom_put("vozocrtx25h", zw3d) ! i-current 284 zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 285 CALL iom_put("vomecrty25h", zw3d ) ! j-current 286 287 zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 288 CALL iom_put("vomecrtz25h", zw3d ) ! k-current 289 zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 290 CALL iom_put("avt25h", zw3d ) ! diffusivity 291 zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 292 CALL iom_put("avm25h", zw3d) ! viscosity 293 #if defined key_zdftke || defined key_zdfgls 294 zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 182 ! Write data for 25 hour mean output streams 183 IF( cnt_25h == 25 .AND. MOD( kt, i_steps*24) == 0 .AND. kt /= nn_it000 ) THEN 184 ! 185 IF(lwp) THEN 186 WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt 187 WRITE(numout,*) '~~~~~~~~~~~~ ' 188 ENDIF 189 ! 190 tn_25h (:,:,:) = tn_25h (:,:,:) * r1_25 191 sn_25h (:,:,:) = sn_25h (:,:,:) * r1_25 192 sshn_25h(:,:) = sshn_25h(:,:) * r1_25 193 un_25h (:,:,:) = un_25h (:,:,:) * r1_25 194 vn_25h (:,:,:) = vn_25h (:,:,:) * r1_25 195 wn_25h (:,:,:) = wn_25h (:,:,:) * r1_25 196 avt_25h (:,:,:) = avt_25h (:,:,:) * r1_25 197 avm_25h (:,:,:) = avm_25h (:,:,:) * r1_25 198 IF( ln_zdftke ) THEN 199 en_25h(:,:,:) = en_25h(:,:,:) * r1_25 200 ENDIF 201 IF( ln_zdfgls ) THEN 202 en_25h (:,:,:) = en_25h (:,:,:) * r1_25 203 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) * r1_25 204 ENDIF 205 ! 206 IF(lwp) WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 207 zmdi=1.e+20 !missing data indicator for masking 208 ! write tracers (instantaneous) 209 zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 210 CALL iom_put("temper25h", zw3d) ! potential temperature 211 zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 212 CALL iom_put( "salin25h", zw3d ) ! salinity 213 zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 214 CALL iom_put( "ssh25h", zw2d ) ! sea surface 215 ! Write velocities (instantaneous) 216 zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 217 CALL iom_put("vozocrtx25h", zw3d) ! i-current 218 zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 219 CALL iom_put("vomecrty25h", zw3d ) ! j-current 220 zw3d(:,:,:) = wn_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 221 CALL iom_put("vomecrtz25h", zw3d ) ! k-current 222 ! Write vertical physics 223 zw3d(:,:,:) = avt_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 224 CALL iom_put("avt25h", zw3d ) ! diffusivity 225 zw3d(:,:,:) = avm_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 226 CALL iom_put("avm25h", zw3d) ! viscosity 227 IF( ln_zdftke ) THEN 228 zw3d(:,:,:) = en_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 295 229 CALL iom_put("tke25h", zw3d) ! tke 296 #endif 297 #if defined key_zdfgls 298 zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 230 ENDIF 231 IF( ln_zdfgls ) THEN 232 zw3d(:,:,:) = en_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 233 CALL iom_put("tke25h", zw3d) ! tke 234 zw3d(:,:,:) = rmxln_25h(:,:,:)*wmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 299 235 CALL iom_put( "mxln25h",zw3d) 300 #endif 301 302 303 tn_25h(:,:,:) = tsn(:,:,:,jp_tem)304 sn_25h(:,:,:) = tsn(:,:,:,jp_sal)305 sshn_25h(:,:) = sshn(:,:)306 un_25h(:,:,:) = un(:,:,:)307 vn_25h(:,:,:) = vn(:,:,:)308 wn_25h(:,:,:) = wn(:,:,:)309 avt_25h(:,:,:) = avt(:,:,:)310 avm_25h(:,:,:) = avm(:,:,:)311 # if defined key_zdfgls || defined key_zdftke 236 ENDIF 237 ! 238 ! After the write reset the values to cnt=1 and sum values equal current value 239 tn_25h (:,:,:) = tsn (:,:,:,jp_tem) 240 sn_25h (:,:,:) = tsn (:,:,:,jp_sal) 241 sshn_25h(:,:) = sshn(:,:) 242 un_25h (:,:,:) = un (:,:,:) 243 vn_25h (:,:,:) = vn (:,:,:) 244 wn_25h (:,:,:) = wn (:,:,:) 245 avt_25h (:,:,:) = avt (:,:,:) 246 avm_25h (:,:,:) = avm (:,:,:) 247 IF( ln_zdftke ) THEN 312 248 en_25h(:,:,:) = en(:,:,:) 313 #endif 314 # if defined key_zdfgls 315 rmxln_25h(:,:,:) = mxln(:,:,:) 316 #endif 317 cnt_25h = 1 318 IF (lwp) WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 319 249 ENDIF 250 IF( ln_zdfgls ) THEN 251 en_25h (:,:,:) = en (:,:,:) 252 rmxln_25h(:,:,:) = hmxl_n(:,:,:) 253 ENDIF 254 cnt_25h = 1 255 IF (lwp) WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 256 ! 320 257 ENDIF ! cnt_25h .EQ. 25 .AND. MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000 321 322 258 ! 323 259 END SUBROUTINE dia_25h 324 260 -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7753 r8215 39 39 40 40 !! * Substitutions 41 # include "zdfddm_substitute.h90"42 41 # include "vectopt_loop_substitute.h90" 43 42 !!---------------------------------------------------------------------- … … 212 211 ! Exclude points where rn2 is negative as convection kicks in here and 213 212 ! work is not being done against stratification 214 CALL wrk_alloc( jpi, jpj, zpe ) 215 zpe(:,:) = 0._wp 216 IF( lk_zdfddm ) THEN 217 DO ji=1,jpi 218 DO jj=1,jpj 219 DO jk=1,jpk 220 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 221 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 222 ! 223 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 224 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 225 ! 226 zpe(ji, jj) = zpe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 227 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 228 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 229 230 ENDDO 231 ENDDO 232 ENDDO 213 CALL wrk_alloc( jpi, jpj, zpe ) 214 zpe(:,:) = 0._wp 215 IF( ln_zdfddm ) THEN 216 DO jk = 2, jpk 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 IF( rn2(ji,jj,jk) > 0._wp ) THEN 220 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 221 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 222 !!gm this can be reduced to : (depw-dept) / e3w (NB idem dans bn2 !) 223 ! zrw = ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 224 !!gm end 225 ! 226 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 227 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 228 ! 229 zpe(ji, jj) = zpe(ji, jj) & 230 & - grav * ( avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 231 & - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 232 ENDIF 233 END DO 234 END DO 235 END DO 233 236 ELSE 234 DO ji = 1, jpi 235 DO jj = 1, jpj 236 DO jk = 1, jpk 237 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 238 ENDDO 239 ENDDO 240 ENDDO 241 ENDIF 242 CALL lbc_lnk( zpe, 'T', 1._wp) 237 DO jk = 1, jpk 238 DO ji = 1, jpi 239 DO jj = 1, jpj 240 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 241 END DO 242 END DO 243 END DO 244 ENDIF 245 !!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj 246 !!gm CALL lbc_lnk( zpe, 'T', 1._wp) 243 247 CALL iom_put( 'tnpeo', zpe ) 244 248 CALL wrk_dealloc( jpi, jpj, zpe ) -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7753 r8215 25 25 !! dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields 26 26 !!---------------------------------------------------------------------- 27 USE oce 28 USE dom_oce 29 USE dynadv, ONLY: ln_dynadv_vec30 USE zdf_oce ! ocean vertical physics31 USE ldftra ! lateral physics: eddy diffusivity coef.32 USE ldfdyn ! lateral physics: eddy viscosity coef.33 USE sbc_oce ! Surface boundary condition: ocean fields34 USE sbc_ice ! Surface boundary condition: ice fields35 USE icb_oce ! Icebergs36 USE icbdia ! Iceberg budgets37 USE sbc ssr ! restoring term toward SST/SSS climatology38 USE phycst ! physical constants39 USE zdfmxl ! mixed layer40 USE dianam ! build name of file (routine)41 USE zdfddm ! vertical physics: double diffusion42 USE diahth ! thermocline diagnostics43 USE wet_dry ! wetting and drying44 USE sbcwave ! wave parameters27 USE oce ! ocean dynamics and tracers 28 USE dom_oce ! ocean space and time domain 29 USE phycst ! physical constants 30 USE dianam ! build name of file (routine) 31 USE diahth ! thermocline diagnostics 32 USE dynadv , ONLY: ln_dynadv_vec 33 USE icb_oce ! Icebergs 34 USE icbdia ! Iceberg budgets 35 USE ldftra ! lateral physics: eddy diffusivity coef. 36 USE ldfdyn ! lateral physics: eddy viscosity coef. 37 USE sbc_oce ! Surface boundary condition: ocean fields 38 USE sbc_ice ! Surface boundary condition: ice fields 39 USE sbcssr ! restoring term toward SST/SSS climatology 40 USE sbcwave ! wave parameters 41 USE wet_dry ! wetting and drying 42 USE zdf_oce ! ocean vertical physics 43 USE zdfdrg ! ocean vertical physics: top/bottom friction 44 USE zdfmxl ! mixed layer 45 45 ! 46 USE lbclnk 47 USE in_out_manager 48 USE diatmb 49 USE dia25h 50 USE iom 51 USE ioipsl 46 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 47 USE in_out_manager ! I/O manager 48 USE diatmb ! Top,middle,bottom output 49 USE dia25h ! 25h Mean output 50 USE iom ! 51 USE ioipsl ! 52 52 53 53 #if defined key_lim2 … … 60 60 USE diurnal_bulk ! diurnal warm layer 61 61 USE cool_skin ! Cool skin 62 USE wrk_nemo ! working array63 62 64 63 IMPLICIT NONE … … 80 79 81 80 !! * Substitutions 82 # include "zdfddm_substitute.h90"83 81 # include "vectopt_loop_substitute.h90" 84 82 !!---------------------------------------------------------------------- … … 120 118 !! ** Method : use iom_put 121 119 !!---------------------------------------------------------------------- 122 !!123 120 INTEGER, INTENT( in ) :: kt ! ocean time-step index 124 121 !! 125 INTEGER :: ji, jj, jk! dummy loop indices126 INTEGER :: jkbot !127 REAL(wp) :: zztmp, zztmpx, zztmpy !128 !!129 REAL(wp), POINTER, DIMENSION(:,:) :: z2d! 2D workspace130 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d! 3D workspace122 INTEGER :: ji, jj, jk ! dummy loop indices 123 INTEGER :: ikbot ! local integer 124 REAL(wp):: zztmp , zztmpx ! local scalar 125 REAL(wp):: zztmp2, zztmpy ! - - 126 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 127 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 131 128 !!---------------------------------------------------------------------- 132 129 ! 133 130 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 134 131 ! 135 CALL wrk_alloc( jpi , jpj , z2d )136 CALL wrk_alloc( jpi , jpj, jpk , z3d )137 !138 132 ! Output the initial state and forcings 139 133 IF( ninist == 1 ) THEN … … 163 157 DO jj = 1, jpj 164 158 DO ji = 1, jpi 165 jkbot = mbkt(ji,jj)166 z2d(ji,jj) = tsn(ji,jj, jkbot,jp_tem)159 ikbot = mbkt(ji,jj) 160 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem) 167 161 END DO 168 162 END DO … … 175 169 DO jj = 1, jpj 176 170 DO ji = 1, jpi 177 jkbot = mbkt(ji,jj)178 z2d(ji,jj) = tsn(ji,jj, jkbot,jp_sal)171 ikbot = mbkt(ji,jj) 172 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal) 179 173 END DO 180 174 END DO … … 183 177 184 178 IF ( iom_use("taubot") ) THEN ! bottom stress 179 zztmp = rau0 * 0.25 185 180 z2d(:,:) = 0._wp 186 181 DO jj = 2, jpjm1 187 182 DO ji = fs_2, fs_jpim1 ! vector opt. 188 zztmp x = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj))&189 & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) )190 zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj ))&191 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) )192 z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy) * tmask(ji,jj,1)183 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * un(ji ,jj,mbku(ji ,jj)) )**2 & 184 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj)) )**2 & 185 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vn(ji,jj ,mbkv(ji,jj )) )**2 & 186 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1)) )**2 187 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 193 188 ! 194 END DO195 END DO189 END DO 190 END DO 196 191 CALL lbc_lnk( z2d, 'T', 1. ) 197 192 CALL iom_put( "taubot", z2d ) 198 193 ENDIF 199 194 200 CALL iom_put( "uoce", un(:,:,:) )! 3D i-current201 CALL iom_put( "ssu", un(:,:,1) )! surface i-current195 CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current 196 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 202 197 IF ( iom_use("sbu") ) THEN 203 198 DO jj = 1, jpj 204 199 DO ji = 1, jpi 205 jkbot = mbku(ji,jj)206 z2d(ji,jj) = un(ji,jj, jkbot)200 ikbot = mbku(ji,jj) 201 z2d(ji,jj) = un(ji,jj,ikbot) 207 202 END DO 208 203 END DO … … 210 205 ENDIF 211 206 212 CALL iom_put( "voce", vn(:,:,:) )! 3D j-current213 CALL iom_put( "ssv", vn(:,:,1) )! surface j-current207 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current 208 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 214 209 IF ( iom_use("sbv") ) THEN 215 210 DO jj = 1, jpj 216 211 DO ji = 1, jpi 217 jkbot = mbkv(ji,jj)218 z2d(ji,jj) = vn(ji,jj, jkbot)212 ikbot = mbkv(ji,jj) 213 z2d(ji,jj) = vn(ji,jj,ikbot) 219 214 END DO 220 215 END DO … … 233 228 ENDIF 234 229 235 CALL iom_put( "avt" , avt )! T vert. eddy diff. coef.236 CALL iom_put( "av m" , avmu ) ! T vert. eddy visc. coef.237 CALL iom_put( "av s" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm)238 239 IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt 240 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) )230 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 231 CALL iom_put( "avs" , avs ) ! S vert. eddy diff. coef. 232 CALL iom_put( "avm" , avm ) ! T vert. eddy visc. coef. 233 234 IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) ) 235 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 241 236 242 237 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN … … 251 246 END DO 252 247 CALL lbc_lnk( z2d, 'T', 1. ) 253 CALL iom_put( "sstgrad2", z2d )! square of module of sst gradient248 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 254 249 z2d(:,:) = SQRT( z2d(:,:) ) 255 CALL iom_put( "sstgrad" , z2d )! module of sst gradient250 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 256 251 ENDIF 257 252 … … 266 261 END DO 267 262 END DO 268 CALL iom_put( "heatc", (rau0 * rcp) * z2d )! vertically integrated heat content (J/m2)263 CALL iom_put( "heatc", rau0_rcp * z2d ) ! vertically integrated heat content (J/m2) 269 264 ENDIF 270 265 … … 278 273 END DO 279 274 END DO 280 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)275 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 281 276 ENDIF 282 277 ! 283 278 IF ( iom_use("eken") ) THEN 284 rke(:,:,jk) = 0._wp ! kinetic energy279 z3d(:,:,jk) = 0._wp 285 280 DO jk = 1, jpkm1 286 281 DO jj = 2, jpjm1 287 282 DO ji = fs_2, fs_jpim1 ! vector opt. 288 zztmp = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 289 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 290 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * e3u_n(ji ,jj,jk) ) & 291 & * zztmp 292 ! 293 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 294 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) & 295 & * zztmp 296 ! 297 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 298 ! 299 ENDDO 300 ENDDO 301 ENDDO 302 CALL lbc_lnk( rke, 'T', 1. ) 303 CALL iom_put( "eken", rke ) 283 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 284 z3d(ji,jj,jk) = zztmp * ( un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 285 & + un(ji ,jj,jk)**2 * e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 286 & + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 287 & + vn(ji,jj ,jk)**2 * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) 288 END DO 289 END DO 290 END DO 291 CALL lbc_lnk( z3d, 'T', 1. ) 292 CALL iom_put( "eken", z3d ) ! kinetic energy 304 293 ENDIF 305 294 ! … … 313 302 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 314 303 END DO 315 CALL iom_put( "u_masstr" , z3d )! mass transport in i-direction316 CALL iom_put( "u_masstr_vint", z2d ) 304 CALL iom_put( "u_masstr" , z3d ) ! mass transport in i-direction 305 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 317 306 ENDIF 318 307 319 308 IF( iom_use("u_heattr") ) THEN 320 z2d(:,:) = 0. e0309 z2d(:,:) = 0._wp 321 310 DO jk = 1, jpkm1 322 311 DO jj = 2, jpjm1 … … 327 316 END DO 328 317 CALL lbc_lnk( z2d, 'U', -1. ) 329 CALL iom_put( "u_heattr", (0.5 * rcp)* z2d ) ! heat transport in i-direction318 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 330 319 ENDIF 331 320 … … 340 329 END DO 341 330 CALL lbc_lnk( z2d, 'U', -1. ) 342 CALL iom_put( "u_salttr", 0.5 * z2d ) 331 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 343 332 ENDIF 344 333 … … 349 338 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 350 339 END DO 351 CALL iom_put( "v_masstr", z3d ) 340 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 352 341 ENDIF 353 342 … … 362 351 END DO 363 352 CALL lbc_lnk( z2d, 'V', -1. ) 364 CALL iom_put( "v_heattr", (0.5 * rcp)* z2d ) ! heat transport in j-direction353 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 365 354 ENDIF 366 355 367 356 IF( iom_use("v_salttr") ) THEN 368 z2d(:,:) = 0. e0357 z2d(:,:) = 0._wp 369 358 DO jk = 1, jpkm1 370 359 DO jj = 2, jpjm1 … … 375 364 END DO 376 365 CALL lbc_lnk( z2d, 'V', -1. ) 377 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 378 ENDIF 379 380 ! Vertical integral of temperature 366 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 367 ENDIF 368 381 369 IF( iom_use("tosmint") ) THEN 382 z2d(:,:) =0._wp370 z2d(:,:) = 0._wp 383 371 DO jk = 1, jpkm1 384 372 DO jj = 2, jpjm1 385 373 DO ji = fs_2, fs_jpim1 ! vector opt. 386 z2d(ji,jj) = z2d(ji,jj) + rau0 *e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem)374 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) 387 375 END DO 388 376 END DO 389 377 END DO 390 378 CALL lbc_lnk( z2d, 'T', -1. ) 391 CALL iom_put( "tosmint", z2d ) 392 ENDIF 393 394 ! Vertical integral of salinity 379 CALL iom_put( "tosmint", rau0 * z2d ) ! Vertical integral of temperature 380 ENDIF 395 381 IF( iom_use("somint") ) THEN 396 382 z2d(:,:)=0._wp … … 398 384 DO jj = 2, jpjm1 399 385 DO ji = fs_2, fs_jpim1 ! vector opt. 400 z2d(ji,jj) = z2d(ji,jj) + rau0 *e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)386 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 401 387 END DO 402 388 END DO 403 389 END DO 404 390 CALL lbc_lnk( z2d, 'T', -1. ) 405 CALL iom_put( "somint", z2d ) 406 ENDIF 407 408 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 409 ! 410 CALL wrk_dealloc( jpi , jpj , z2d ) 411 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 412 ! 413 ! If we want tmb values 414 415 IF (ln_diatmb) THEN 416 CALL dia_tmb 417 ENDIF 418 IF (ln_dia25h) THEN 419 CALL dia_25h( kt ) 420 ENDIF 391 CALL iom_put( "somint", rau0 * z2d ) ! Vertical integral of salinity 392 ENDIF 393 394 CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2) 395 ! 396 397 IF (ln_diatmb) CALL dia_tmb ! tmb values 398 399 IF (ln_dia25h) CALL dia_25h( kt ) ! 25h averaging 421 400 422 401 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') … … 452 431 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 453 432 ! 454 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace455 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace433 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 434 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 456 435 !!---------------------------------------------------------------------- 457 436 ! 458 437 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 459 438 ! 460 CALL wrk_alloc( jpi,jpj , zw2d ) 461 IF( .NOT.ln_linssh ) CALL wrk_alloc( jpi,jpj,jpk , zw3d ) 462 ! 463 ! Output the initial state and forcings 464 IF( ninist == 1 ) THEN 439 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 465 440 CALL dia_wri_state( 'output.init', kt ) 466 441 ninist = 0 … … 470 445 ! ----------------- 471 446 472 ! local variable for debugging 473 ll_print = .FALSE. 447 ll_print = .FALSE. ! local variable for debugging 474 448 ll_print = ll_print .AND. lwp 475 449 … … 747 721 CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt 748 722 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 749 CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity" , "m2/s" , & ! avm u723 CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity" , "m2/s" , & ! avm 750 724 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 751 725 752 IF( l k_zdfddm ) THEN726 IF( ln_zdfddm ) THEN 753 727 CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity" , "m2/s" , & ! avs 754 728 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) … … 874 848 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 875 849 CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. 876 CALL histwrite( nid_W, "votkeavm", it, avm u, ndim_T, ndex_T ) ! T vert. eddy visc. coef.877 IF( l k_zdfddm ) THEN878 CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T ) ! S vert. eddy diff. coef.850 CALL histwrite( nid_W, "votkeavm", it, avm , ndim_T, ndex_T ) ! T vert. eddy visc. coef. 851 IF( ln_zdfddm ) THEN 852 CALL histwrite( nid_W, "voddmavs", it, avs , ndim_T, ndex_T ) ! S vert. eddy diff. coef. 879 853 ENDIF 880 854 881 855 IF( ln_wave .AND. ln_sdw ) THEN 882 CALL histwrite( nid_U, "sdzocrtx", it, usd 883 CALL histwrite( nid_V, "sdmecrty", it, vsd 884 CALL histwrite( nid_W, "sdvecrtz", it, wsd 856 CALL histwrite( nid_U, "sdzocrtx", it, usd , ndim_U , ndex_U ) ! i-StokesDrift-current 857 CALL histwrite( nid_V, "sdmecrty", it, vsd , ndim_V , ndex_V ) ! j-StokesDrift-current 858 CALL histwrite( nid_W, "sdvecrtz", it, wsd , ndim_T , ndex_T ) ! StokesDrift vert. current 885 859 ENDIF 886 860 … … 893 867 CALL histclo( nid_W ) 894 868 ENDIF 895 !896 CALL wrk_dealloc( jpi , jpj , zw2d )897 IF( .NOT.ln_linssh ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d )898 869 ! 899 870 IF( nn_timing == 1 ) CALL timing_stop('dia_wri')
Note: See TracChangeset
for help on using the changeset viewer.
