Changeset 10162 for branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

Timestamp:

2018-10-02T13:27:34+02:00 (6 years ago)

Author:

dford

Message:

Add NEMO-FABM coupling code, essentially identical to commit 4bc68d33 of the PML NEMO-FABM GitLab?.

File:

• branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90 (modified) (4 diffs)

branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

@@ -21 +21 @@
    USE trcwri_c14b
    USE trcwri_my_trc
+   ! +++>>> FABM
+   USE trcwri_fabm
+   ! FABM <<<+++
 
    IMPLICIT NONE
@@ -32 +35 @@
 CONTAINS
 
+#if defined key_tracer_budget
+   SUBROUTINE trc_wri( kt , fl)  !slwa
+#else
    SUBROUTINE trc_wri( kt )
+#endif
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE trc_wri  ***
@@ -39 +46 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in )     :: kt
+      ! +++>>>FABM
+#if defined key_tracer_budget
+      INTEGER, INTENT( in ), OPTIONAL     :: fl  ! slwa
+#endif
+      ! FABM <<<+++
       !
       INTEGER                   :: jn
@@ -59 +71 @@
       IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
       IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14
-      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
+      ! +++>>>FABM
+#if defined key_tracer_budget
+      IF( PRESENT(fl) ) THEN
+         IF( lk_fabm    )   CALL trc_wri_fabm (kt, fl) ! MY_TRC  tracers for budget
+         IF( lk_my_trc ) CALL trc_wri_my_trc (kt, fl)    ! MY_TRC  tracers for budget
+      ELSE
+         IF( lk_fabm    )   CALL trc_wri_fabm (kt) ! FABM  tracers for budget
+         IF( lk_my_trc  )   CALL trc_wri_my_trc (kt) ! MY_TRC  tracers
+      ENDIF
+#else
+      IF( lk_fabm  )   CALL trc_wri_fabm (kt)     ! FABM  tracers
+      IF( lk_my_trc  )   CALL trc_wri_my_trc(kt)     ! MY_TRC  tracers
+#endif
+      ! FABM <<<+++
       !
+
       IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
       !