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.
trcwri_fabm.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90 @ 13576

Last change on this file since 13576 was 13576, checked in by dford, 3 years ago

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 size: 5.4 KB
Line 
1MODULE trcwri_fabm
2   !!======================================================================
3   !!                       *** MODULE trcwri_fabm ***
4   !!    fabm :   Output of FABM tracers
5   !!======================================================================
6   !! History :   1.0  !  2015-04  (PML) Original code
7   !! History :   1.1  !  2020-06  (PML) Update to FABM 1.0, improved performance
8   !!----------------------------------------------------------------------
9#if defined key_top && key_fabm && defined key_iomput
10   !!----------------------------------------------------------------------
11   !!   'key_fabm'                                           FABM model
12   !!----------------------------------------------------------------------
13   !! trc_wri_fabm   :  outputs of concentration fields
14   !!----------------------------------------------------------------------
15   USE trc         ! passive tracers common variables
16   USE iom         ! I/O manager
17   USE trdtrc_oce
18   USE trcsms_fabm, only: trc_sms_fabm_check_mass
19   USE par_fabm
20   USE st2d_fabm
21
22   IMPLICIT NONE
23   PRIVATE
24
25#if defined key_tracer_budget
26   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: tr_temp
27   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: fabm_st2d_temp
28#endif
29
30   INTERFACE trc_wri_fabm
31       MODULE PROCEDURE wri_fabm,wri_fabm_fl
32   END INTERFACE trc_wri_fabm
33
34   PUBLIC trc_wri_fabm 
35
36#  include "top_substitute.h90"
37CONTAINS
38
39   SUBROUTINE wri_fabm_fl(kt,fl)
40      !!---------------------------------------------------------------------
41      !!                     ***  ROUTINE trc_wri_trc  ***
42      !!
43      !! ** Purpose :   output passive tracers fields
44      !!---------------------------------------------------------------------
45      INTEGER, INTENT( in )               :: fl
46      INTEGER, INTENT( in )               :: kt
47
48#if defined key_tracer_budget
49      INTEGER              :: jn
50      CHARACTER (len=20)   :: cltra
51      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: trpool !temporary storage pool 3D
52      REAL(wp), DIMENSION(jpi,jpj)    :: st2dpool !temporary storage pool 2D
53      !!---------------------------------------------------------------------
54 
55      ! write the tracer concentrations in the file
56      ! ---------------------------------------
57! depth integrated
58! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt
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(:,:,:) + &
62                             tr_temp(:,:,:,jn)*fse3t(:,:,:) )
63         cltra = TRIM( model%interior_state_variables(jn)%name )//"_e3t"     ! depth integrated output
64         IF( kt == nittrc000 ) write(6,*)'output pool ',cltra
65         CALL iom_put( cltra, trpool)
66        ENDIF
67      END DO
68#else
69      CONTINUE
70#endif
71
72   END SUBROUTINE wri_fabm_fl
73
74   SUBROUTINE wri_fabm(kt)
75      !!---------------------------------------------------------------------
76      !!                     ***  ROUTINE trc_wri_trc  ***
77      !!
78      !! ** Purpose :   output passive tracers fields
79      !!---------------------------------------------------------------------
80      INTEGER, INTENT( in )               :: kt
81      INTEGER              :: jn, jk
82      REAL(wp), DIMENSION(jpi,jpj)    :: vint
83
84#if defined key_tracer_budget
85      IF( kt == nittrc000 ) THEN
86         ALLOCATE(tr_temp(jpi,jpj,jpk,jp_fabm),fabm_st2d_temp(jpi,jpj,jp_fabm_surface+jp_fabm_bottom))
87      ENDIF
88      tr_temp(:,:,:,:)=trn(:,:,:,jp_fabm0:jp_fabm1) ! slwa save for tracer budget (unfiltered trn)
89      fabm_st2d_temp(:,:,:)=fabm_st2dn(:,:,:)
90#endif
91      DO jn = 1, jp_fabm
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
103      END DO
104      DO jn = 1, jp_fabm_surface
105         CALL iom_put( model%surface_state_variables(jn)%name, fabm_st2dn(:,:,jn) )
106      END DO
107      DO jn = 1, jp_fabm_bottom
108         CALL iom_put( model%bottom_state_variables(jn)%name, fabm_st2dn(:,:,jp_fabm_surface+jn) )
109      END DO
110
111      CALL trc_sms_fabm_check_mass
112
113   END SUBROUTINE wri_fabm
114
115#else
116   !!----------------------------------------------------------------------
117   !!  Dummy module :                                     No passive tracer
118   !!----------------------------------------------------------------------
119   INTERFACE trc_wri_fabm
120       MODULE PROCEDURE wri_fabm,wri_fabm_fl
121   END INTERFACE trc_wri_fabm
122
123   PUBLIC 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
136#endif
137
138   !!----------------------------------------------------------------------
139   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
140   !! $Id$
141   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
142   !!======================================================================
143END MODULE trcwri_fabm
Note: See TracBrowser for help on using the repository browser.