Ignore:
Timestamp:
2018-12-14T13:53:52+01:00 (23 months ago)
Author:
dford
Message:

Add 25-hour mean and top-middle-bottom diagnostics for all variables available through FABM, and set up indices for specific variables for easier access by OBS/ASM. See internal Met Office NEMO ticket 760.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r8561 r10390  
    2121#endif 
    2222   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_interior_diagnostic_data, & 
     28      &            fabm_get_horizontal_diagnostic_data 
     29#endif 
    2330 
    2431   IMPLICIT NONE 
     
    3946#if defined key_zdfgls  
    4047   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 
    4155#endif 
    4256   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means 
     
    6478      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6579      INTEGER ::   ierror              ! Local integer for memory allocation 
     80      INTEGER ::   jn                  ! Loop counter 
    6681      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace 
    6782      ! 
     
    145160         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN 
    146161      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  
    147184      ! ------------------------- ! 
    148185      ! 2 - Assign Initial Values ! 
     
    169206         rmxln_25h(:,:,:) = mxln(:,:,:) 
    170207#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_interior_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 
    171225#if defined key_lim3 || defined key_lim2 
    172226         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
     
    207261 
    208262      !! * Local declarations 
    209       INTEGER ::   ji, jj, jk 
     263      INTEGER ::   ji, jj, jk, jn 
    210264 
    211265      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout 
     
    268322         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    269323#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_interior_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 
    270341         cnt_25h = cnt_25h + 1 
    271342 
     
    300371# if defined key_zdfgls 
    301372            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 
    302380#endif 
    303381 
     
    319397            CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    320398 
     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 
    321422 
    322423            ! Write velocities (instantaneous) 
     
    362463            rmxln_25h(:,:,:) = mxln(:,:,:) 
    363464#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_interior_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 
    364482            cnt_25h = 1 
    365483            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.