Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 7 edited
-
dia25h.F90 (modified) (8 diffs)
-
diaar5.F90 (modified) (5 diffs)
-
diacfl.F90 (modified) (6 diffs)
-
diadct.F90 (modified) (4 diffs)
-
diahth.F90 (modified) (2 diffs)
-
diaptr.F90 (modified) (1 diff)
-
diawri.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r8329 r9019 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 12 ! 10 13 USE in_out_manager ! I/O units 11 14 USE iom ! I/0 library 12 USE wrk_nemo ! working arrays13 #if defined key_zdftke14 USE zdf_oce, ONLY: en15 #endif16 USE zdf_oce, ONLY: avt, avm17 #if defined key_zdfgls18 USE zdf_oce, ONLY: en19 USE zdfgls, ONLY: mxln20 #endif21 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 150 #if defined key_lim3 || defined key_lim2 151 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 107 ENDIF 108 IF( ln_zdfgls ) THEN 109 en_25h (:,:,:) = en (:,:,:) 110 rmxln_25h(:,:,:) = hmxl_n(:,:,:) 111 ENDIF 112 #if defined key_lim3 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 = 1318 IF (lwp) WRITE(numout,*) 'dia_wri_tide : &319 & After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h320 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 : & 256 & After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average', cnt_25h 321 257 ENDIF ! cnt_25h .EQ. 25 .AND. MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000 322 323 258 ! 324 259 END SUBROUTINE dia_25h 325 260 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r8083 r9019 39 39 40 40 !! * Substitutions 41 # include "zdfddm_substitute.h90"42 41 # include "vectopt_loop_substitute.h90" 43 42 !!---------------------------------------------------------------------- … … 214 213 CALL wrk_alloc( jpi, jpj, zpe ) 215 214 zpe(:,:) = 0._wp 216 IF( l k_zdfddm ) THEN215 IF( ln_zdfddm ) THEN 217 216 DO jk = 2, jpk 218 217 DO jj = 1, jpj … … 221 220 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 222 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 223 225 ! 224 226 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw … … 226 228 ! 227 229 zpe(ji, jj) = zpe(ji, jj) & 228 & - grav * ( 229 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )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) ) ) 230 232 ENDIF 231 233 END DO … … 241 243 END DO 242 244 ENDIF 243 CALL lbc_lnk( zpe, 'T', 1._wp) 244 CALL iom_put( 'tnpeo', zpe ) 245 CALL wrk_dealloc( jpi, jpj, zpe ) 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) 247 CALL iom_put( 'tnpeo', zpe ) 248 CALL wrk_dealloc( jpi, jpj, zpe ) 246 249 ENDIF 247 250 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
r8329 r9019 1 1 MODULE diacfl 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE diacfl *** 4 4 !! Output CFL diagnostics to ascii file 5 !!====================================================================== ========6 !! History : 1.0! 2010-03 (E. Blockley) Original code7 !! ! 2014-06 (T Graham)Removed CPP key & Updated to vn3.68 !! 5 !!====================================================================== 6 !! History : 3.4 ! 2010-03 (E. Blockley) Original code 7 !! 3.6 ! 2014-06 (T. Graham) Removed CPP key & Updated to vn3.6 8 !! 4.0 ! 2017-09 (G. Madec) style + comments 9 9 !!---------------------------------------------------------------------- 10 10 !! dia_cfl : Compute and output Courant numbers at each timestep … … 12 12 USE oce ! ocean dynamics and active tracers 13 13 USE dom_oce ! ocean space and time domain 14 USE domvvl ! 15 ! 14 16 USE lib_mpp ! distribued memory computing 15 17 USE lbclnk ! ocean lateral boundary condition (or mpp link) 16 18 USE in_out_manager ! I/O manager 17 USE domvvl18 19 USE timing ! Performance output 19 20 … … 21 22 PRIVATE 22 23 23 REAL(wp) :: cu_max, cv_max, cw_max ! Run max U Courant number24 INTEGER , DIMENSION(3) :: cu_loc, cv_loc, cw_loc ! Run max locations25 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcu_cfl ! Courant number arrays26 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcv_cfl ! Courant number arrays27 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcw_cfl ! Courant number arrays24 CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii" ! ascii filename 25 INTEGER :: numcfl ! outfile unit 26 ! 27 INTEGER, DIMENSION(3) :: nCu_loc, nCv_loc, nCw_loc ! U, V, and W run max locations in the global domain 28 REAL(wp) :: rCu_max, rCv_max, rCw_max ! associated run max Courant number 28 29 29 INTEGER :: numcfl ! outfile unit 30 CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii" ! ascii filename 30 !!gm CAUTION: need to declare these arrays here, otherwise the calculation fails in multi-proc ! 31 !!gm I don't understand why. 32 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace 33 !!gm end 31 34 32 35 PUBLIC dia_cfl ! routine called by step.F90 … … 40 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 44 !!---------------------------------------------------------------------- 42 43 44 45 CONTAINS 45 46 46 47 47 SUBROUTINE dia_cfl ( kt ) … … 52 52 !! and output to ascii file 'cfl_diagnostics.ascii' 53 53 !!---------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt ! ocean time-step index 55 ! 56 INTEGER :: ji, jj, jk ! dummy loop indices 57 REAL(wp):: z2dt, zCu_max, zCv_max, zCw_max ! local scalars 58 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace 59 !!gm this does not work REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace 60 !!---------------------------------------------------------------------- 61 ! 62 IF( nn_timing == 1 ) CALL timing_start('dia_cfl') 63 ! 64 ! ! setup timestep multiplier to account for initial Eulerian timestep 65 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdt 66 ELSE ; z2dt = rdt * 2._wp 67 ENDIF 68 ! 69 ! 70 DO jk = 1, jpk ! calculate Courant numbers 71 DO jj = 1, jpj 72 DO ji = 1, fs_jpim1 ! vector opt. 73 zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u (ji,jj) ! for i-direction 74 zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v (ji,jj) ! for j-direction 75 zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk) ! for k-direction 76 END DO 77 END DO 78 END DO 79 ! 80 ! ! calculate maximum values and locations 81 IF( lk_mpp ) THEN 82 CALL mpp_maxloc( zCu_cfl, umask, zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) ) 83 CALL mpp_maxloc( zCv_cfl, vmask, zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) ) 84 CALL mpp_maxloc( zCw_cfl, wmask, zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) ) 85 ELSE 86 iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 87 iloc_u(1) = iloc(1) + nimpp - 1 88 iloc_u(2) = iloc(2) + njmpp - 1 89 iloc_u(3) = iloc(3) 90 zCu_max = zCu_cfl(iloc(1),iloc(2),iloc(3)) 91 ! 92 iloc = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 93 iloc_v(1) = iloc(1) + nimpp - 1 94 iloc_v(2) = iloc(2) + njmpp - 1 95 iloc_v(3) = iloc(3) 96 zCv_max = zCv_cfl(iloc(1),iloc(2),iloc(3)) 97 ! 98 iloc = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 99 iloc_w(1) = iloc(1) + nimpp - 1 100 iloc_w(2) = iloc(2) + njmpp - 1 101 iloc_w(3) = iloc(3) 102 zCw_max = zCw_cfl(iloc(1),iloc(2),iloc(3)) 103 ENDIF 104 ! 105 ! ! write out to file 106 IF( lwp ) THEN 107 WRITE(numcfl,FMT='(2x,i4,5x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 108 WRITE(numcfl,FMT='(11x, a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 109 WRITE(numcfl,FMT='(11x, a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) 110 ENDIF 111 ! 112 ! ! update maximum Courant numbers from whole run if applicable 113 IF( zCu_max > rCu_max ) THEN ; rCu_max = zCu_max ; nCu_loc(:) = iloc_u(:) ; ENDIF 114 IF( zCv_max > rCv_max ) THEN ; rCv_max = zCv_max ; nCv_loc(:) = iloc_v(:) ; ENDIF 115 IF( zCw_max > rCw_max ) THEN ; rCw_max = zCw_max ; nCw_loc(:) = iloc_w(:) ; ENDIF 54 116 55 INTEGER, INTENT(in) :: kt ! ocean time-step index 117 ! ! at end of run output max Cu and Cv and close ascii file 118 IF( kt == nitend .AND. lwp ) THEN 119 ! to ascii file 120 WRITE(numcfl,*) '******************************************' 121 WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3) 122 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max 123 WRITE(numcfl,*) '******************************************' 124 WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3) 125 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max 126 WRITE(numcfl,*) '******************************************' 127 WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3) 128 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max 129 CLOSE( numcfl ) 130 ! 131 ! to ocean output 132 WRITE(numout,*) 133 WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 134 WRITE(numout,*) '~~~~~~~' 135 WRITE(numout,*) ' Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max 136 WRITE(numout,*) ' Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max 137 WRITE(numout,*) ' Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max 138 ENDIF 139 ! 140 IF( nn_timing == 1 ) CALL timing_stop('dia_cfl') 141 ! 142 END SUBROUTINE dia_cfl 56 143 57 REAL(wp) :: zcu_max, zcv_max, zcw_max ! max Courant numbers per timestep58 INTEGER, DIMENSION(3) :: zcu_loc, zcv_loc, zcw_loc ! max Courant number locations59 60 REAL(wp) :: dt ! temporary scalars61 INTEGER, DIMENSION(3) :: zlocu, zlocv, zlocw ! temporary arrays62 INTEGER :: ji, jj, jk ! dummy loop indices63 64 65 IF( nn_diacfl == 1) THEN66 IF( nn_timing == 1 ) CALL timing_start('dia_cfl')67 ! setup timestep multiplier to account for initial Eulerian timestep68 IF( neuler == 0 .AND. kt == nit000 ) THEN ; dt = rdt69 ELSE ; dt = rdt * 2.070 ENDIF71 72 ! calculate Courant numbers73 DO jk = 1, jpk74 DO jj = 1, jpj75 DO ji = 1, fs_jpim1 ! vector opt.76 77 ! Courant number for x-direction (zonal current)78 zcu_cfl(ji,jj,jk) = ABS(un(ji,jj,jk))*dt/e1u(ji,jj)79 80 ! Courant number for y-direction (meridional current)81 zcv_cfl(ji,jj,jk) = ABS(vn(ji,jj,jk))*dt/e2v(ji,jj)82 83 ! Courant number for z-direction (vertical current)84 zcw_cfl(ji,jj,jk) = ABS(wn(ji,jj,jk))*dt/e3w_n(ji,jj,jk)85 END DO86 END DO87 END DO88 89 ! calculate maximum values and locations90 IF( lk_mpp ) THEN91 CALL mpp_maxloc(zcu_cfl,umask,zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3))92 CALL mpp_maxloc(zcv_cfl,vmask,zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3))93 CALL mpp_maxloc(zcw_cfl,tmask,zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3))94 ELSE95 zlocu = MAXLOC( ABS( zcu_cfl(:,:,:) ) )96 zcu_loc(1) = zlocu(1) + nimpp - 197 zcu_loc(2) = zlocu(2) + njmpp - 198 zcu_loc(3) = zlocu(3)99 zcu_max = zcu_cfl(zcu_loc(1),zcu_loc(2),zcu_loc(3))100 101 zlocv = MAXLOC( ABS( zcv_cfl(:,:,:) ) )102 zcv_loc(1) = zlocv(1) + nimpp - 1103 zcv_loc(2) = zlocv(2) + njmpp - 1104 zcv_loc(3) = zlocv(3)105 zcv_max = zcv_cfl(zcv_loc(1),zcv_loc(2),zcv_loc(3))106 107 zlocw = MAXLOC( ABS( zcw_cfl(:,:,:) ) )108 zcw_loc(1) = zlocw(1) + nimpp - 1109 zcw_loc(2) = zlocw(2) + njmpp - 1110 zcw_loc(3) = zlocw(3)111 zcw_max = zcw_cfl(zcw_loc(1),zcw_loc(2),zcw_loc(3))112 ENDIF113 114 ! write out to file115 IF( lwp ) THEN116 WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3)117 WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3)118 WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3)119 ENDIF120 121 ! update maximum Courant numbers from whole run if applicable122 IF( zcu_max > cu_max ) THEN123 cu_max = zcu_max124 cu_loc = zcu_loc125 ENDIF126 IF( zcv_max > cv_max ) THEN127 cv_max = zcv_max128 cv_loc = zcv_loc129 ENDIF130 IF( zcw_max > cw_max ) THEN131 cw_max = zcw_max132 cw_loc = zcw_loc133 ENDIF134 135 ! at end of run output max Cu and Cv and close ascii file136 IF( kt == nitend .AND. lwp ) THEN137 ! to ascii file138 WRITE(numcfl,*) '******************************************'139 WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', cu_max, cu_loc(1), cu_loc(2), cu_loc(3)140 WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max)141 WRITE(numcfl,*) '******************************************'142 WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', cv_max, cv_loc(1), cv_loc(2), cv_loc(3)143 WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max)144 WRITE(numcfl,*) '******************************************'145 WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', cw_max, cw_loc(1), cw_loc(2), cw_loc(3)146 WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max)147 CLOSE( numcfl )148 149 ! to ocean output150 WRITE(numout,*)151 WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run:'152 WRITE(numout,*) '~~~~~~~~~~~~'153 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, 'at (i, j, k) = &154 & (', cu_loc(1), cu_loc(2), cu_loc(3), ')'155 WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max)156 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, 'at (i, j, k) = &157 & (', cv_loc(1), cv_loc(2), cv_loc(3), ')'158 WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max)159 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, 'at (i, j, k) = &160 & (', cw_loc(1), cw_loc(2), cw_loc(3), ')'161 WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max)162 163 ENDIF164 165 IF( nn_timing == 1 ) CALL timing_stop('dia_cfl')166 ENDIF167 168 END SUBROUTINE dia_cfl169 144 170 145 SUBROUTINE dia_cfl_init … … 174 149 !! ** Purpose : create output file, initialise arrays 175 150 !!---------------------------------------------------------------------- 176 177 178 IF( nn_diacfl == 1 ) THEN 179 IF( nn_timing == 1 ) CALL timing_start('dia_cfl_init') 180 181 cu_max=0.0 182 cv_max=0.0 183 cw_max=0.0 184 185 ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 186 187 zcu_cfl(:,:,:)=0.0 188 zcv_cfl(:,:,:)=0.0 189 zcw_cfl(:,:,:)=0.0 190 191 IF( lwp ) THEN 192 WRITE(numout,*) 193 WRITE(numout,*) 'dia_cfl : Outputting CFL diagnostics to '//TRIM(clname) 194 WRITE(numout,*) '~~~~~~~~~~~~' 195 WRITE(numout,*) 196 197 ! create output ascii file 198 CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 199 WRITE(numcfl,*) 'Timestep Direction Max C i j k' 200 WRITE(numcfl,*) '******************************************' 201 ENDIF 202 203 IF( nn_timing == 1 ) CALL timing_stop('dia_cfl_init') 204 151 ! 152 IF(lwp) THEN 153 WRITE(numout,*) 154 WRITE(numout,*) 'dia_cfl : Outputting CFL diagnostics to ',TRIM(clname), ' file' 155 WRITE(numout,*) '~~~~~~~' 156 WRITE(numout,*) 157 ! 158 ! create output ascii file 159 CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 160 WRITE(numcfl,*) 'Timestep Direction Max C i j k' 161 WRITE(numcfl,*) '******************************************' 205 162 ENDIF 206 163 ! 164 rCu_max = 0._wp 165 rCv_max = 0._wp 166 rCw_max = 0._wp 167 ! 168 !!gm required to work 169 ALLOCATE ( zCu_cfl(jpi,jpj,jpk), zCv_cfl(jpi,jpj,jpk), zCw_cfl(jpi,jpj,jpk) ) 170 !!gm end 171 ! 207 172 END SUBROUTINE dia_cfl_init 208 173 174 !!====================================================================== 209 175 END MODULE diacfl -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r8126 r9019 32 32 USE dianam ! build name of file 33 33 USE lib_mpp ! distributed memory computing library 34 #if defined key_lim235 USE ice_236 #endif37 34 #if defined key_lim3 38 35 USE ice … … 747 744 END DO !end of loop on the level 748 745 749 #if defined key_lim 2 || defined key_lim3746 #if defined key_lim3 750 747 751 748 !ICE CASE … … 769 766 zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 770 767 771 #if defined key_lim2772 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* &773 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &774 *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + &775 hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))776 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* &777 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))778 #endif779 768 #if defined key_lim3 780 769 DO jl=1,jpl 781 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* &782 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) *&783 ( h t_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) + &784 h t_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) )770 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 771 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * & 772 ( h_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) + & 773 h_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) ) 785 774 786 775 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 787 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl)776 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) 788 777 END DO 789 778 #endif … … 956 945 ENDIF ! end of test if point is in class 957 946 958 END DO ! end of loop on the classes959 960 END DO ! loop over jk961 962 #if defined key_lim 2 || defined key_lim3947 END DO ! end of loop on the classes 948 949 END DO ! loop over jk 950 951 #if defined key_lim3 963 952 964 953 !ICE CASE -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r6140 r9019 139 139 DO jj = 1, jpj 140 140 DO ji = 1, jpi 141 zztmp = bathy(ji,jj)141 zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1) 142 142 hth (ji,jj) = zztmp 143 143 zabs2 (ji,jj) = zztmp … … 150 150 DO jj = 1, jpj 151 151 DO ji = 1, jpi 152 zztmp = bathy(ji,jj)152 zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1) 153 153 zrho0_3(ji,jj) = zztmp 154 154 zrho0_1(ji,jj) = zztmp -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7753 r9019 397 397 REWIND( numnam_cfg ) ! Namelist namptr in configuration namelist : Poleward transport 398 398 READ ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 399 902 IF( ios /=0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp )399 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 400 400 IF(lwm) WRITE ( numond, namptr ) 401 401 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8465 r9019 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 ! 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 53 #if defined key_lim2 54 USE limwri_2 55 #elif defined key_lim3 56 USE limwri 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 53 #if defined key_lim3 54 USE icewri 57 55 #endif 58 56 USE lib_mpp ! MPP library … … 60 58 USE diurnal_bulk ! diurnal warm layer 61 59 USE cool_skin ! Cool skin 62 USE wrk_nemo ! working array63 60 64 61 IMPLICIT NONE … … 80 77 81 78 !! * Substitutions 82 # include "zdfddm_substitute.h90"83 79 # include "vectopt_loop_substitute.h90" 84 80 !!---------------------------------------------------------------------- … … 120 116 !! ** Method : use iom_put 121 117 !!---------------------------------------------------------------------- 122 !!123 118 INTEGER, INTENT( in ) :: kt ! ocean time-step index 124 119 !! 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 workspace120 INTEGER :: ji, jj, jk ! dummy loop indices 121 INTEGER :: ikbot ! local integer 122 REAL(wp):: zztmp , zztmpx ! local scalar 123 REAL(wp):: zztmp2, zztmpy ! - - 124 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 125 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 131 126 !!---------------------------------------------------------------------- 132 127 ! 133 128 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 134 129 ! 135 CALL wrk_alloc( jpi , jpj , z2d )136 CALL wrk_alloc( jpi , jpj, jpk , z3d )137 !138 130 ! Output the initial state and forcings 139 131 IF( ninist == 1 ) THEN … … 163 155 DO jj = 1, jpj 164 156 DO ji = 1, jpi 165 jkbot = mbkt(ji,jj)166 z2d(ji,jj) = tsn(ji,jj, jkbot,jp_tem)157 ikbot = mbkt(ji,jj) 158 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem) 167 159 END DO 168 160 END DO … … 175 167 DO jj = 1, jpj 176 168 DO ji = 1, jpi 177 jkbot = mbkt(ji,jj)178 z2d(ji,jj) = tsn(ji,jj, jkbot,jp_sal)169 ikbot = mbkt(ji,jj) 170 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal) 179 171 END DO 180 172 END DO … … 183 175 184 176 IF ( iom_use("taubot") ) THEN ! bottom stress 177 zztmp = rau0 * 0.25 185 178 z2d(:,:) = 0._wp 186 179 DO jj = 2, jpjm1 187 180 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)181 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * un(ji ,jj,mbku(ji ,jj)) )**2 & 182 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj)) )**2 & 183 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vn(ji,jj ,mbkv(ji,jj )) )**2 & 184 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1)) )**2 185 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 193 186 ! 194 END DO195 END DO187 END DO 188 END DO 196 189 CALL lbc_lnk( z2d, 'T', 1. ) 197 190 CALL iom_put( "taubot", z2d ) 198 191 ENDIF 199 192 200 CALL iom_put( "uoce", un(:,:,:) )! 3D i-current201 CALL iom_put( "ssu", un(:,:,1) )! surface i-current193 CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current 194 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 202 195 IF ( iom_use("sbu") ) THEN 203 196 DO jj = 1, jpj 204 197 DO ji = 1, jpi 205 jkbot = mbku(ji,jj)206 z2d(ji,jj) = un(ji,jj, jkbot)198 ikbot = mbku(ji,jj) 199 z2d(ji,jj) = un(ji,jj,ikbot) 207 200 END DO 208 201 END DO … … 210 203 ENDIF 211 204 212 CALL iom_put( "voce", vn(:,:,:) )! 3D j-current213 CALL iom_put( "ssv", vn(:,:,1) )! surface j-current205 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current 206 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 214 207 IF ( iom_use("sbv") ) THEN 215 208 DO jj = 1, jpj 216 209 DO ji = 1, jpi 217 jkbot = mbkv(ji,jj)218 z2d(ji,jj) = vn(ji,jj, jkbot)210 ikbot = mbkv(ji,jj) 211 z2d(ji,jj) = vn(ji,jj,ikbot) 219 212 END DO 220 213 END DO … … 233 226 ENDIF 234 227 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(:,:,:) ) ) )228 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 229 CALL iom_put( "avs" , avs ) ! S vert. eddy diff. coef. 230 CALL iom_put( "avm" , avm ) ! T vert. eddy visc. coef. 231 232 IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) ) 233 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 241 234 242 235 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN … … 251 244 END DO 252 245 CALL lbc_lnk( z2d, 'T', 1. ) 253 CALL iom_put( "sstgrad2", z2d )! square of module of sst gradient246 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 254 247 z2d(:,:) = SQRT( z2d(:,:) ) 255 CALL iom_put( "sstgrad" , z2d )! module of sst gradient248 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 256 249 ENDIF 257 250 258 ! clem: heat and salt content251 ! heat and salt contents 259 252 IF( iom_use("heatc") ) THEN 260 253 z2d(:,:) = 0._wp … … 266 259 END DO 267 260 END DO 268 CALL iom_put( "heatc", (rau0 * rcp) * z2d )! vertically integrated heat content (J/m2)261 CALL iom_put( "heatc", rau0_rcp * z2d ) ! vertically integrated heat content (J/m2) 269 262 ENDIF 270 263 … … 278 271 END DO 279 272 END DO 280 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)273 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 281 274 ENDIF 282 275 ! 283 276 IF ( iom_use("eken") ) THEN 284 rke(:,:,jpk) = 0._wp ! kinetic energy277 z3d(:,:,jk) = 0._wp 285 278 DO jk = 1, jpkm1 286 279 DO jj = 2, jpjm1 287 280 DO ji = fs_2, fs_jpim1 ! vector opt. 288 zztmp = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 289 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 290 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e1e2u(ji ,jj) * e3u_n(ji ,jj,jk) ) & 291 & * zztmp 292 ! 293 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1e2v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 294 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1e2v(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 ) 281 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 282 z3d(ji,jj,jk) = zztmp * ( un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 283 & + un(ji ,jj,jk)**2 * e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 284 & + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 285 & + vn(ji,jj ,jk)**2 * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) 286 END DO 287 END DO 288 END DO 289 CALL lbc_lnk( z3d, 'T', 1. ) 290 CALL iom_put( "eken", z3d ) ! kinetic energy 304 291 ENDIF 305 292 ! … … 313 300 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 314 301 END DO 315 CALL iom_put( "u_masstr" , z3d )! mass transport in i-direction316 CALL iom_put( "u_masstr_vint", z2d ) 302 CALL iom_put( "u_masstr" , z3d ) ! mass transport in i-direction 303 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 317 304 ENDIF 318 305 319 306 IF( iom_use("u_heattr") ) THEN 320 z2d(:,:) = 0. e0307 z2d(:,:) = 0._wp 321 308 DO jk = 1, jpkm1 322 309 DO jj = 2, jpjm1 … … 327 314 END DO 328 315 CALL lbc_lnk( z2d, 'U', -1. ) 329 CALL iom_put( "u_heattr", (0.5 * rcp)* z2d ) ! heat transport in i-direction316 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 330 317 ENDIF 331 318 … … 340 327 END DO 341 328 CALL lbc_lnk( z2d, 'U', -1. ) 342 CALL iom_put( "u_salttr", 0.5 * z2d ) 329 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 343 330 ENDIF 344 331 … … 349 336 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 350 337 END DO 351 CALL iom_put( "v_masstr", z3d ) 338 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 352 339 ENDIF 353 340 … … 362 349 END DO 363 350 CALL lbc_lnk( z2d, 'V', -1. ) 364 CALL iom_put( "v_heattr", (0.5 * rcp)* z2d ) ! heat transport in j-direction351 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 365 352 ENDIF 366 353 367 354 IF( iom_use("v_salttr") ) THEN 368 z2d(:,:) = 0. e0355 z2d(:,:) = 0._wp 369 356 DO jk = 1, jpkm1 370 357 DO jj = 2, jpjm1 … … 375 362 END DO 376 363 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 364 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 365 ENDIF 366 381 367 IF( iom_use("tosmint") ) THEN 382 z2d(:,:) =0._wp368 z2d(:,:) = 0._wp 383 369 DO jk = 1, jpkm1 384 370 DO jj = 2, jpjm1 385 371 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)372 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) 387 373 END DO 388 374 END DO 389 375 END DO 390 376 CALL lbc_lnk( z2d, 'T', -1. ) 391 CALL iom_put( "tosmint", z2d ) 392 ENDIF 393 394 ! Vertical integral of salinity 377 CALL iom_put( "tosmint", rau0 * z2d ) ! Vertical integral of temperature 378 ENDIF 395 379 IF( iom_use("somint") ) THEN 396 380 z2d(:,:)=0._wp … … 398 382 DO jj = 2, jpjm1 399 383 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)384 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 401 385 END DO 402 386 END DO 403 387 END DO 404 388 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 389 CALL iom_put( "somint", rau0 * z2d ) ! Vertical integral of salinity 390 ENDIF 391 392 CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2) 393 ! 394 395 IF (ln_diatmb) CALL dia_tmb ! tmb values 396 397 IF (ln_dia25h) CALL dia_25h( kt ) ! 25h averaging 421 398 422 399 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') … … 452 429 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 453 430 ! 454 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace455 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace431 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 432 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 456 433 !!---------------------------------------------------------------------- 457 434 ! 458 435 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 459 436 ! 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 437 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 465 438 CALL dia_wri_state( 'output.init', kt ) 466 439 ninist = 0 … … 470 443 ! ----------------- 471 444 472 ! local variable for debugging 473 ll_print = .FALSE. 445 ll_print = .FALSE. ! local variable for debugging 474 446 ll_print = ll_print .AND. lwp 475 447 … … 707 679 #endif 708 680 709 IF( ln_cpl .AND. nn_ice == 2 ) THEN710 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice711 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )712 CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice713 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )714 ENDIF715 716 681 CALL histend( nid_T, snc4chunks=snc4set ) 717 682 … … 747 712 CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt 748 713 & 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 u714 CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity" , "m2/s" , & ! avm 750 715 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 751 716 752 IF( l k_zdfddm ) THEN717 IF( ln_zdfddm ) THEN 753 718 CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity" , "m2/s" , & ! avs 754 719 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) … … 861 826 #endif 862 827 863 IF( ln_cpl .AND. nn_ice == 2 ) THEN864 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature865 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo866 ENDIF867 868 828 CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current 869 829 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress … … 874 834 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 875 835 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.836 CALL histwrite( nid_W, "votkeavm", it, avm , ndim_T, ndex_T ) ! T vert. eddy visc. coef. 837 IF( ln_zdfddm ) THEN 838 CALL histwrite( nid_W, "voddmavs", it, avs , ndim_T, ndex_T ) ! S vert. eddy diff. coef. 879 839 ENDIF 880 840 881 841 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 842 CALL histwrite( nid_U, "sdzocrtx", it, usd , ndim_U , ndex_U ) ! i-StokesDrift-current 843 CALL histwrite( nid_V, "sdmecrty", it, vsd , ndim_V , ndex_V ) ! j-StokesDrift-current 844 CALL histwrite( nid_W, "sdvecrtz", it, wsd , ndim_T , ndex_T ) ! StokesDrift vert. current 885 845 ENDIF 886 846 … … 893 853 CALL histclo( nid_W ) 894 854 ENDIF 895 !896 CALL wrk_dealloc( jpi , jpj , zw2d )897 IF( .NOT.ln_linssh ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d )898 855 ! 899 856 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') … … 1009 966 ENDIF 1010 967 1011 #if defined key_lim 21012 CALL lim_wri_state_2( kt, id_i, nh_i )1013 #elif defined key_lim3 1014 CALL lim_wri_state( kt, id_i, nh_i )968 #if defined key_lim3 969 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 970 CALL ice_wri_state( kt, id_i, nh_i ) 971 ENDIF 1015 972 #else 1016 973 CALL histend( id_i, snc4chunks=snc4set )
Note: See TracChangeset
for help on using the changeset viewer.
