Changeset 10308 for branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
- Timestamp:
- 2018-11-14T18:42:09+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r8561 r10308 21 21 #endif 22 22 USE diatmb 23 #if defined key_fabm 24 USE trc, ONLY: trn, visib 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 55 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_visib_25h 41 56 #endif 42 57 INTEGER, SAVE :: cnt_25h ! Counter for 25 hour means … … 64 79 INTEGER :: ios ! Local integer output status for namelist read 65 80 INTEGER :: ierror ! Local integer for memory allocation 81 INTEGER :: jn ! Loop counter 66 82 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! temporary workspace 67 83 ! … … 145 161 CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' ) ; RETURN 146 162 ENDIF 163 #if defined key_fabm 164 ALLOCATE( fabm_25h(jpi,jpj,jpk,jp_fabm), STAT=ierror ) 165 IF( ierror > 0 ) THEN 166 CALL ctl_stop( 'dia_25h: unable to allocate fabm_25h' ) ; RETURN 167 ENDIF 168 ALLOCATE( fabm_3d_25h(jpi,jpj,jpk,jp_fabm_3d), STAT=ierror ) 169 IF( ierror > 0 ) THEN 170 CALL ctl_stop( 'dia_25h: unable to allocate fabm_3d_25h' ) ; RETURN 171 ENDIF 172 ALLOCATE( fabm_surface_25h(jpi,jpj,jp_fabm_surface), STAT=ierror ) 173 IF( ierror > 0 ) THEN 174 CALL ctl_stop( 'dia_25h: unable to allocate fabm_surface_25h' ) ; RETURN 175 ENDIF 176 ALLOCATE( fabm_bottom_25h(jpi,jpj,jp_fabm_bottom), STAT=ierror ) 177 IF( ierror > 0 ) THEN 178 CALL ctl_stop( 'dia_25h: unable to allocate fabm_bottom_25h' ) ; RETURN 179 ENDIF 180 ALLOCATE( fabm_2d_25h(jpi,jpj,jp_fabm_2d), STAT=ierror ) 181 IF( ierror > 0 ) THEN 182 CALL ctl_stop( 'dia_25h: unable to allocate fabm_2d_25h' ) ; RETURN 183 ENDIF 184 ALLOCATE( fabm_visib_25h(jpi,jpj,jpk), STAT=ierror ) 185 IF( ierror > 0 ) THEN 186 CALL ctl_stop( 'dia_25h: unable to allocate fabm_visib_25h' ) ; RETURN 187 ENDIF 188 #endif 147 189 ! ------------------------- ! 148 190 ! 2 - Assign Initial Values ! … … 169 211 rmxln_25h(:,:,:) = mxln(:,:,:) 170 212 #endif 213 #if defined key_fabm 214 DO jn = 1, jp_fabm 215 fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 216 END DO 217 DO jn = 1, jp_fabm_3d 218 fabm_3d_25h(:,:,:,jn) = fabm_get_bulk_diagnostic_data(model, jn) 219 END DO 220 DO jn = 1, jp_fabm_surface 221 fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 222 END DO 223 DO jn = 1, jp_fabm_bottom 224 fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 225 END DO 226 DO jn = 1, jp_fabm_2d 227 fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 228 END DO 229 fabm_visib_25h(:,:,:) = visib(:,:,:) 230 #endif 171 231 #if defined key_lim3 || defined key_lim2 172 232 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 207 267 208 268 !! * Local declarations 209 INTEGER :: ji, jj, jk 269 INTEGER :: ji, jj, jk, jn 210 270 211 271 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 268 328 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 269 329 #endif 330 #if defined key_fabm 331 DO jn = 1, jp_fabm 332 fabm_25h(:,:,:,jn) = fabm_25h(:,:,:,jn) + trn(:,:,:,jp_fabm_m1+jn) 333 END DO 334 DO jn = 1, jp_fabm_3d 335 fabm_3d_25h(:,:,:,jn) = fabm_3d_25h(:,:,:,jn) + fabm_get_bulk_diagnostic_data(model, jn) 336 END DO 337 DO jn = 1, jp_fabm_surface 338 fabm_surface_25h(:,:,jn) = fabm_surface_25h(:,:,jn) + fabm_st2dn(:,:,jn) 339 END DO 340 DO jn = 1, jp_fabm_bottom 341 fabm_bottom_25h(:,:,jn) = fabm_bottom_25h(:,:,jn) + fabm_st2dn(:,:,jp_fabm_surface+jn) 342 END DO 343 DO jn = 1, jp_fabm_2d 344 fabm_2d_25h(:,:,jn) = fabm_2d_25h(:,:,jn) + fabm_get_horizontal_diagnostic_data(model,jn) 345 END DO 346 fabm_visib_25h(:,:,:) = fabm_visib_25h(:,:,:) + visib(:,:,:) 347 #endif 270 348 cnt_25h = cnt_25h + 1 271 349 … … 300 378 # if defined key_zdfgls 301 379 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 380 #endif 381 #if defined key_fabm 382 fabm_25h(:,:,:,:) = fabm_25h(:,:,:,:) / 25.0_wp 383 fabm_3d_25h(:,:,:,:) = fabm_3d_25h(:,:,:,:) / 25.0_wp 384 fabm_surface_25h(:,:,:) = fabm_surface_25h(:,:,:) / 25.0_wp 385 fabm_bottom_25h(:,:,:) = fabm_bottom_25h(:,:,:) / 25.0_wp 386 fabm_2d_25h(:,:,:) = fabm_2d_25h(:,:,:) / 25.0_wp 387 fabm_visib_25h(:,:,:) = fabm_visib_25h(:,:,:) / 25.0_wp 302 388 #endif 303 389 … … 319 405 CALL iom_put( "ssh25h", zw2d ) ! sea surface 320 406 407 #if defined key_fabm 408 ! Write ERSEM variables 409 DO jn = 1, jp_fabm 410 zw3d(:,:,:) = fabm_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 411 CALL iom_put( TRIM(model%state_variables(jn)%name)//"25h", zw3d ) 412 END DO 413 DO jn = 1, jp_fabm_3d 414 zw3d(:,:,:) = fabm_3d_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 415 CALL iom_put( TRIM(model%diagnostic_variables(jn)%name)//"25h", zw3d ) 416 END DO 417 DO jn = 1, jp_fabm_surface 418 zw2d(:,:) = fabm_surface_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 419 CALL iom_put( TRIM(model%surface_state_variables(jn)%name)//"25h", zw2d ) 420 END DO 421 DO jn = 1, jp_fabm_bottom 422 zw2d(:,:) = fabm_bottom_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 423 CALL iom_put( TRIM(model%bottom_state_variables(jn)%name)//"25h", zw2d ) 424 END DO 425 DO jn = 1, jp_fabm_2d 426 zw2d(:,:) = fabm_2d_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 427 CALL iom_put( TRIM(model%horizontal_diagnostic_variables(jn)%name)//"25h", zw2d ) 428 END DO 429 zw3d(:,:,:) = fabm_visib_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 430 CALL iom_put( "visib25h", zw3d ) 431 #endif 321 432 322 433 ! Write velocities (instantaneous) … … 362 473 rmxln_25h(:,:,:) = mxln(:,:,:) 363 474 #endif 475 #if defined key_fabm 476 DO jn = 1, jp_fabm 477 fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 478 END DO 479 DO jn = 1, jp_fabm_3d 480 fabm_3d_25h(:,:,:,jn) = fabm_get_bulk_diagnostic_data(model, jn) 481 END DO 482 DO jn = 1, jp_fabm_surface 483 fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 484 END DO 485 DO jn = 1, jp_fabm_bottom 486 fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 487 END DO 488 DO jn = 1, jp_fabm_2d 489 fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 490 END DO 491 fabm_visib_25h(:,:,:) = visib(:,:,:) 492 #endif 364 493 cnt_25h = 1 365 494 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.
