Changeset 10205 for branches/UKMO/AMM15_v3_6_STABLE_package_bgc_updates/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
- Timestamp:
- 2018-10-19T13:36:08+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_bgc_updates/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r8561 r10205 21 21 #endif 22 22 USE diatmb 23 #if defined key_fabm 24 USE trc, ONLY: trn 25 USE par_fabm 26 USE st2d_fabm, ONLY: fabm_st2dn 27 USE fabm, ONLY: fabm_get_bulk_diagnostic_data, & 28 & fabm_get_horizontal_diagnostic_data 29 #endif 23 30 24 31 IMPLICIT NONE … … 39 46 #if defined key_zdfgls 40 47 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rmxln_25h 48 #endif 49 #if defined key_fabm 50 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: fabm_25h 51 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: fabm_3d_25h 52 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_surface_25h 53 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_bottom_25h 54 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_2d_25h 41 55 #endif 42 56 INTEGER, SAVE :: cnt_25h ! Counter for 25 hour means … … 64 78 INTEGER :: ios ! Local integer output status for namelist read 65 79 INTEGER :: ierror ! Local integer for memory allocation 80 INTEGER :: jn ! Loop counter 66 81 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! temporary workspace 67 82 ! … … 145 160 CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' ) ; RETURN 146 161 ENDIF 162 #if defined key_fabm 163 ALLOCATE( fabm_25h(jpi,jpj,jpk,jp_fabm), STAT=ierror ) 164 IF( ierror > 0 ) THEN 165 CALL ctl_stop( 'dia_25h: unable to allocate fabm_25h' ) ; RETURN 166 ENDIF 167 ALLOCATE( fabm_3d_25h(jpi,jpj,jpk,jp_fabm_3d), STAT=ierror ) 168 IF( ierror > 0 ) THEN 169 CALL ctl_stop( 'dia_25h: unable to allocate fabm_3d_25h' ) ; RETURN 170 ENDIF 171 ALLOCATE( fabm_surface_25h(jpi,jpj,jp_fabm_surface), STAT=ierror ) 172 IF( ierror > 0 ) THEN 173 CALL ctl_stop( 'dia_25h: unable to allocate fabm_surface_25h' ) ; RETURN 174 ENDIF 175 ALLOCATE( fabm_bottom_25h(jpi,jpj,jp_fabm_bottom), STAT=ierror ) 176 IF( ierror > 0 ) THEN 177 CALL ctl_stop( 'dia_25h: unable to allocate fabm_bottom_25h' ) ; RETURN 178 ENDIF 179 ALLOCATE( fabm_2d_25h(jpi,jpj,jp_fabm_2d), STAT=ierror ) 180 IF( ierror > 0 ) THEN 181 CALL ctl_stop( 'dia_25h: unable to allocate fabm_2d_25h' ) ; RETURN 182 ENDIF 183 #endif 147 184 ! ------------------------- ! 148 185 ! 2 - Assign Initial Values ! … … 169 206 rmxln_25h(:,:,:) = mxln(:,:,:) 170 207 #endif 208 #if defined key_fabm 209 DO jn = 1, jp_fabm 210 fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 211 END DO 212 DO jn = 1, jp_fabm_3d 213 fabm_3d_25h(:,:,:,jn) = fabm_get_bulk_diagnostic_data(model, jn) 214 END DO 215 DO jn = 1, jp_fabm_surface 216 fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 217 END DO 218 DO jn = 1, jp_fabm_bottom 219 fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 220 END DO 221 DO jn = 1, jp_fabm_2d 222 fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 223 END DO 224 #endif 171 225 #if defined key_lim3 || defined key_lim2 172 226 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 207 261 208 262 !! * Local declarations 209 INTEGER :: ji, jj, jk 263 INTEGER :: ji, jj, jk, jn 210 264 211 265 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 268 322 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 269 323 #endif 324 #if defined key_fabm 325 DO jn = 1, jp_fabm 326 fabm_25h(:,:,:,jn) = fabm_25h(:,:,:,jn) + trn(:,:,:,jp_fabm_m1+jn) 327 END DO 328 DO jn = 1, jp_fabm_3d 329 fabm_3d_25h(:,:,:,jn) = fabm_3d_25h(:,:,:,jn) + fabm_get_bulk_diagnostic_data(model, jn) 330 END DO 331 DO jn = 1, jp_fabm_surface 332 fabm_surface_25h(:,:,jn) = fabm_surface_25h(:,:,jn) + fabm_st2dn(:,:,jn) 333 END DO 334 DO jn = 1, jp_fabm_bottom 335 fabm_bottom_25h(:,:,jn) = fabm_bottom_25h(:,:,jn) + fabm_st2dn(:,:,jp_fabm_surface+jn) 336 END DO 337 DO jn = 1, jp_fabm_2d 338 fabm_2d_25h(:,:,jn) = fabm_2d_25h(:,:,jn) + fabm_get_horizontal_diagnostic_data(model,jn) 339 END DO 340 #endif 270 341 cnt_25h = cnt_25h + 1 271 342 … … 300 371 # if defined key_zdfgls 301 372 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 373 #endif 374 #if defined key_fabm 375 fabm_25h(:,:,:,:) = fabm_25h(:,:,:,:) / 25.0_wp 376 fabm_3d_25h(:,:,:,:) = fabm_3d_25h(:,:,:,:) / 25.0_wp 377 fabm_surface_25h(:,:,:) = fabm_surface_25h(:,:,:) / 25.0_wp 378 fabm_bottom_25h(:,:,:) = fabm_bottom_25h(:,:,:) / 25.0_wp 379 fabm_2d_25h(:,:,:) = fabm_2d_25h(:,:,:) / 25.0_wp 302 380 #endif 303 381 … … 319 397 CALL iom_put( "ssh25h", zw2d ) ! sea surface 320 398 399 #if defined key_fabm 400 ! Write ERSEM variables 401 DO jn = 1, jp_fabm 402 zw3d(:,:,:) = fabm_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 403 CALL iom_put( TRIM(model%state_variables(jn)%name)//"25h", zw3d ) 404 END DO 405 DO jn = 1, jp_fabm_3d 406 zw3d(:,:,:) = fabm_3d_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 407 CALL iom_put( TRIM(model%diagnostic_variables(jn)%name)//"25h", zw3d ) 408 END DO 409 DO jn = 1, jp_fabm_surface 410 zw2d(:,:) = fabm_surface_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 411 CALL iom_put( TRIM(model%surface_state_variables(jn)%name)//"25h", zw2d ) 412 END DO 413 DO jn = 1, jp_fabm_bottom 414 zw2d(:,:) = fabm_bottom_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 415 CALL iom_put( TRIM(model%bottom_state_variables(jn)%name)//"25h", zw2d ) 416 END DO 417 DO jn = 1, jp_fabm_2d 418 zw2d(:,:) = fabm_2d_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 419 CALL iom_put( TRIM(model%horizontal_diagnostic_variables(jn)%name)//"25h", zw2d ) 420 END DO 421 #endif 321 422 322 423 ! Write velocities (instantaneous) … … 362 463 rmxln_25h(:,:,:) = mxln(:,:,:) 363 464 #endif 465 #if defined key_fabm 466 DO jn = 1, jp_fabm 467 fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 468 END DO 469 DO jn = 1, jp_fabm_3d 470 fabm_3d_25h(:,:,:,jn) = fabm_get_bulk_diagnostic_data(model, jn) 471 END DO 472 DO jn = 1, jp_fabm_surface 473 fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 474 END DO 475 DO jn = 1, jp_fabm_bottom 476 fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 477 END DO 478 DO jn = 1, jp_fabm_2d 479 fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 480 END DO 481 #endif 364 482 cnt_25h = 1 365 483 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
Note: See TracChangeset
for help on using the changeset viewer.
