Changeset 13576 for branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcnam_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/trcnam_fabm.F90 (modified) (3 diffs)

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

@@ -4 +4 @@
    !! TOP :   initialisation of some run parameters for FABM bio-model
    !!======================================================================
-   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) 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_fabm
@@ -18 +19 @@
    USE par_fabm
    USE trcsms_fabm
-
 
    IMPLICIT NONE
@@ -35 +35 @@
 
    SUBROUTINE trc_nam_fabm
+      LOGICAL :: l_ext
+      INTEGER :: nmlunit, ios
+      NAMELIST/namfabm/ nn_adv
+
+      ! Read NEMO-FABM coupler settings from namfabm
+      nn_adv = 3
+      INQUIRE( FILE='namelist_fabm_ref', EXIST=l_ext )
+      IF (l_ext) then
+         CALL ctl_opn( nmlunit, 'namelist_fabm_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.)
+         READ(nmlunit, nml=namfabm, iostat=ios)
+         IF( ios /= 0 ) CALL ctl_nam ( ios , 'namfabm in namelist_fabm_ref', .TRUE. )
+      END IF
+      INQUIRE( FILE='namelist_fabm_cfg', EXIST=l_ext )
+      IF (l_ext) then
+         CALL ctl_opn( nmlunit, 'namelist_fabm_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.)
+         READ(nmlunit, nml=namfabm, iostat=ios)
+         IF( ios /= 0 ) CALL ctl_nam ( ios , 'namfabm in namelist_fabm_cfg', .TRUE. )
+      END IF
+      IF (nn_adv /= 1 .and. nn_adv /= 3) CALL ctl_stop( 'STOP', 'trc_ini_fabm: nn_adv must be 1 or 3.' )
    END SUBROUTINE trc_nam_fabm
 
-   SUBROUTINE trc_nam_fabm_override
+   SUBROUTINE trc_nam_fabm_override(sn_tracer)
+      TYPE(PTRACER), DIMENSION(jpmaxtrc), INTENT(INOUT) :: sn_tracer
+
       INTEGER :: jn
+      CHARACTER(LEN=3) :: index
 
       DO jn=1,jp_fabm
-         ctrcnm(jp_fabm_m1+jn) = model%state_variables(jn)%name
-         ctrcln(jp_fabm_m1+jn) = model%state_variables(jn)%long_name
-         ctrcun(jp_fabm_m1+jn) = model%state_variables(jn)%units
-         ln_trc_ini(jp_fabm_m1+jn) = .FALSE.
+         IF (sn_tracer(jn)%clsname /= 'NONAME' .AND. sn_tracer(jn)%clsname /= model%interior_state_variables(jn)%name) THEN
+            WRITE (index,'(i0)') jn
+            CALL ctl_stop('Tracer name mismatch in namtrc: '//TRIM(sn_tracer(jn)%clsname)//' found at sn_tracer('//TRIM(index)//') where '//TRIM(model%interior_state_variables(jn)%name)//' was expected.')
+         END IF
+         sn_tracer(jn)%clsname = TRIM(model%interior_state_variables(jn)%name)
+         sn_tracer(jn)%cllname = TRIM(model%interior_state_variables(jn)%long_name)
+         sn_tracer(jn)%clunit = TRIM(model%interior_state_variables(jn)%units)
+         sn_tracer(jn)%llinit = .FALSE.
       END DO
    END SUBROUTINE trc_nam_fabm_override
-   
+
 #else
    !!----------------------------------------------------------------------