Changeset 13576 for branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90

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:

• branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90 (modified) (8 diffs)

branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90

@@ -4 +4 @@
    !!    fabm :   Output of FABM tracers
    !!======================================================================
-   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !! History :   1.0  !  2015-04  (PML) Original code
+   !! History :   1.1  !  2020-06  (PML) Update to FABM 1.0, improved performance
    !!----------------------------------------------------------------------
 #if defined key_top && key_fabm && defined key_iomput
@@ -18 +19 @@
    USE par_fabm
    USE st2d_fabm
-   USE fabm, only: fabm_get_bulk_diagnostic_data, fabm_get_horizontal_diagnostic_data
 
    IMPLICIT NONE
@@ -31 +31 @@
        MODULE PROCEDURE wri_fabm,wri_fabm_fl
    END INTERFACE trc_wri_fabm
-
 
    PUBLIC trc_wri_fabm 
@@ -58 +57 @@
 ! depth integrated
 ! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt
-      DO jn = 1, jp_fabm1
-        IF(ln_trdtrc (jn))THEN
-         trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm0+jn-1)*fse3t_a(:,:,:) + &
+      DO jn = 1, jp_fabm
+        IF(ln_trdtrc (jp_fabm_m1+jn))THEN
+         trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm_m1+jn)*fse3t_a(:,:,:) + &
                              tr_temp(:,:,:,jn)*fse3t(:,:,:) )
-         cltra = TRIM( model%state_variables(jn)%name )//"_e3t"     ! depth integrated output
+         cltra = TRIM( model%interior_state_variables(jn)%name )//"_e3t"     ! depth integrated output
          IF( kt == nittrc000 ) write(6,*)'output pool ',cltra
          CALL iom_put( cltra, trpool)
@@ -80 +79 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in )               :: kt
-      INTEGER              :: jn
+      INTEGER              :: jn, jk
+      REAL(wp), DIMENSION(jpi,jpj)    :: vint
 
 #if defined key_tracer_budget
@@ -90 +90 @@
 #endif
       DO jn = 1, jp_fabm
-         CALL iom_put( model%state_variables(jn)%name, trn(:,:,:,jp_fabm0+jn-1) )
+         ! Save 3D field
+         CALL iom_put(model%interior_state_variables(jn)%name, trn(:,:,:,jp_fabm_m1+jn))
+
+         ! Save depth integral if selected for output in XIOS
+         IF (iom_use(TRIM(model%interior_state_variables(jn)%name)//'_VINT')) THEN
+            vint = 0._wp
+            DO jk = 1, jpkm1
+               vint = vint + trn(:,:,jk,jp_fabm_m1+jn) * fse3t(:,:,jk) * tmask(:,:,jk)
+            END DO
+            CALL iom_put(TRIM(model%interior_state_variables(jn)%name)//'_VINT', vint)
+         END IF
       END DO
       DO jn = 1, jp_fabm_surface
@@ -99 +109 @@
       END DO
 
-      ! write 3D diagnostics in the file
-      ! ---------------------------------------
-      DO jn = 1, size(model%diagnostic_variables)
-         IF (model%diagnostic_variables(jn)%save) &
-             CALL iom_put( model%diagnostic_variables(jn)%name, fabm_get_bulk_diagnostic_data(model,jn))
-      END DO
-
-      ! write 2D diagnostics in the file
-      ! ---------------------------------------
-      DO jn = 1, size(model%horizontal_diagnostic_variables)
-         IF (model%horizontal_diagnostic_variables(jn)%save) &
-             CALL iom_put( model%horizontal_diagnostic_variables(jn)%name, fabm_get_horizontal_diagnostic_data(model,jn))
-      END DO
-      !
       CALL trc_sms_fabm_check_mass
 
@@ -121 +117 @@
    !!  Dummy module :                                     No passive tracer
    !!----------------------------------------------------------------------
+   INTERFACE trc_wri_fabm
+       MODULE PROCEDURE wri_fabm,wri_fabm_fl
+   END INTERFACE trc_wri_fabm
+
    PUBLIC trc_wri_fabm
-CONTAINS
-   SUBROUTINE trc_wri_fabm                     ! Empty routine  
-   END SUBROUTINE trc_wri_fabm
+
+   CONTAINS
+
+   SUBROUTINE wri_fabm_fl(kt,fl)
+      INTEGER, INTENT( in )               :: fl
+      INTEGER, INTENT( in )               :: kt
+   END SUBROUTINE wri_fabm_fl
+
+   SUBROUTINE wri_fabm(kt)                 ! Empty routine  
+      INTEGER, INTENT( in )               :: kt
+   END SUBROUTINE wri_fabm
+
 #endif