New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13576 for branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90 – NEMO

Ignore:
Timestamp:
2020-10-09T12:35:11+02:00 (4 years ago)
Author:
dford
Message:

Update NEMO-FABM coupler for FABM v1, and introduce two-way NEMO-ERSEM coupling options. See https://code.metoffice.gov.uk/trac/utils/ticket/366.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90

    r10270 r13576  
    44   !!    fabm :   Output of FABM tracers 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
     6   !! History :   1.0  !  2015-04  (PML) Original code 
     7   !! History :   1.1  !  2020-06  (PML) Update to FABM 1.0, improved performance 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_top && key_fabm && defined key_iomput 
     
    1819   USE par_fabm 
    1920   USE st2d_fabm 
    20    USE fabm, only: fabm_get_bulk_diagnostic_data, fabm_get_horizontal_diagnostic_data 
    2121 
    2222   IMPLICIT NONE 
     
    3131       MODULE PROCEDURE wri_fabm,wri_fabm_fl 
    3232   END INTERFACE trc_wri_fabm 
    33  
    3433 
    3534   PUBLIC trc_wri_fabm  
     
    5857! depth integrated 
    5958! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt 
    60       DO jn = 1, jp_fabm1 
    61         IF(ln_trdtrc (jn))THEN 
    62          trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm0+jn-1)*fse3t_a(:,:,:) + & 
     59      DO jn = 1, jp_fabm 
     60        IF(ln_trdtrc (jp_fabm_m1+jn))THEN 
     61         trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm_m1+jn)*fse3t_a(:,:,:) + & 
    6362                             tr_temp(:,:,:,jn)*fse3t(:,:,:) ) 
    64          cltra = TRIM( model%state_variables(jn)%name )//"_e3t"     ! depth integrated output 
     63         cltra = TRIM( model%interior_state_variables(jn)%name )//"_e3t"     ! depth integrated output 
    6564         IF( kt == nittrc000 ) write(6,*)'output pool ',cltra 
    6665         CALL iom_put( cltra, trpool) 
     
    8079      !!--------------------------------------------------------------------- 
    8180      INTEGER, INTENT( in )               :: kt 
    82       INTEGER              :: jn 
     81      INTEGER              :: jn, jk 
     82      REAL(wp), DIMENSION(jpi,jpj)    :: vint 
    8383 
    8484#if defined key_tracer_budget 
     
    9090#endif 
    9191      DO jn = 1, jp_fabm 
    92          CALL iom_put( model%state_variables(jn)%name, trn(:,:,:,jp_fabm0+jn-1) ) 
     92         ! Save 3D field 
     93         CALL iom_put(model%interior_state_variables(jn)%name, trn(:,:,:,jp_fabm_m1+jn)) 
     94 
     95         ! Save depth integral if selected for output in XIOS 
     96         IF (iom_use(TRIM(model%interior_state_variables(jn)%name)//'_VINT')) THEN 
     97            vint = 0._wp 
     98            DO jk = 1, jpkm1 
     99               vint = vint + trn(:,:,jk,jp_fabm_m1+jn) * fse3t(:,:,jk) * tmask(:,:,jk) 
     100            END DO 
     101            CALL iom_put(TRIM(model%interior_state_variables(jn)%name)//'_VINT', vint) 
     102         END IF 
    93103      END DO 
    94104      DO jn = 1, jp_fabm_surface 
     
    99109      END DO 
    100110 
    101       ! write 3D diagnostics in the file 
    102       ! --------------------------------------- 
    103       DO jn = 1, size(model%diagnostic_variables) 
    104          IF (model%diagnostic_variables(jn)%save) & 
    105              CALL iom_put( model%diagnostic_variables(jn)%name, fabm_get_bulk_diagnostic_data(model,jn)) 
    106       END DO 
    107  
    108       ! write 2D diagnostics in the file 
    109       ! --------------------------------------- 
    110       DO jn = 1, size(model%horizontal_diagnostic_variables) 
    111          IF (model%horizontal_diagnostic_variables(jn)%save) & 
    112              CALL iom_put( model%horizontal_diagnostic_variables(jn)%name, fabm_get_horizontal_diagnostic_data(model,jn)) 
    113       END DO 
    114       ! 
    115111      CALL trc_sms_fabm_check_mass 
    116112 
     
    121117   !!  Dummy module :                                     No passive tracer 
    122118   !!---------------------------------------------------------------------- 
     119   INTERFACE trc_wri_fabm 
     120       MODULE PROCEDURE wri_fabm,wri_fabm_fl 
     121   END INTERFACE trc_wri_fabm 
     122 
    123123   PUBLIC trc_wri_fabm 
    124 CONTAINS 
    125    SUBROUTINE trc_wri_fabm                     ! Empty routine   
    126    END SUBROUTINE trc_wri_fabm 
     124 
     125   CONTAINS 
     126 
     127   SUBROUTINE wri_fabm_fl(kt,fl) 
     128      INTEGER, INTENT( in )               :: fl 
     129      INTEGER, INTENT( in )               :: kt 
     130   END SUBROUTINE wri_fabm_fl 
     131 
     132   SUBROUTINE wri_fabm(kt)                 ! Empty routine   
     133      INTEGER, INTENT( in )               :: kt 
     134   END SUBROUTINE wri_fabm 
     135 
    127136#endif 
    128137 
Note: See TracChangeset for help on using the changeset viewer.