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 NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM – NEMO

source: NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90 @ 15480

Last change on this file since 15480 was 15480, checked in by jcastill, 8 months ago

Changes as in the git branch NEMO-FABMv1-ERSEM

File size: 6.1 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   USE,INTRINSIC :: iso_fortran_env, only: output_unit
22
23   IMPLICIT NONE
24   PRIVATE
25
26#if defined key_tracer_budget
27   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: tr_temp
28   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: fabm_st2d_temp
29#endif
30
31   INTERFACE trc_wri_fabm
32       MODULE PROCEDURE wri_fabm,wri_fabm_fl
33   END INTERFACE trc_wri_fabm
34
35   PUBLIC trc_wri_fabm 
36
37#  include "top_substitute.h90"
38CONTAINS
39
40   SUBROUTINE wri_fabm_fl(kt,fl)
41      !!---------------------------------------------------------------------
42      !!                     ***  ROUTINE trc_wri_trc  ***
43      !!
44      !! ** Purpose :   output passive tracers fields
45      !!---------------------------------------------------------------------
46      INTEGER, INTENT( in )               :: fl
47      INTEGER, INTENT( in )               :: kt
48
49#if defined key_tracer_budget
50      INTEGER              :: jn
51      CHARACTER (len=20)   :: cltra
52      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: trpool !temporary storage pool 3D
53      REAL(wp), DIMENSION(jpi,jpj)    :: st2dpool !temporary storage pool 2D
54      !!---------------------------------------------------------------------
55 
56      ! write the tracer concentrations in the file
57      ! ---------------------------------------
58! depth integrated
59! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt
60      DO jn = 1, jp_fabm
61        IF(ln_trdtrc (jp_fabm_m1+jn))THEN
62         trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm_m1+jn)*fse3t_a(:,:,:) + &
63                             tr_temp(:,:,:,jn)*fse3t(:,:,:) )
64         cltra = TRIM( model%interior_state_variables(jn)%name )//"_e3t"     ! depth integrated output
65         IF( kt == nittrc000 ) write(output_unit,*)'output pool ',cltra
66         CALL iom_put( cltra, trpool)
67        ENDIF
68      END DO
69#else
70      CONTINUE
71#endif
72
73   END SUBROUTINE wri_fabm_fl
74
75   SUBROUTINE wri_fabm(kt)
76      !!---------------------------------------------------------------------
77      !!                     ***  ROUTINE trc_wri_trc  ***
78      !!
79      !! ** Purpose :   output passive tracers fields
80      !!---------------------------------------------------------------------
81      INTEGER, INTENT( in )               :: kt
82      INTEGER              :: jn, jk
83      REAL(wp), DIMENSION(jpi,jpj)    :: vint
84
85#if defined key_tracer_budget
86      IF( kt == nittrc000 ) THEN
87         ALLOCATE(tr_temp(jpi,jpj,jpk,jp_fabm),fabm_st2d_temp(jpi,jpj,jp_fabm_surface+jp_fabm_bottom))
88      ENDIF
89      tr_temp(:,:,:,:)=trn(:,:,:,jp_fabm0:jp_fabm1) ! slwa save for tracer budget (unfiltered trn)
90      fabm_st2d_temp(:,:,:)=fabm_st2dn(:,:,:)
91#endif
92      DO jn = 1, jp_fabm
93         ! Save 3D field
94         CALL iom_put(model%interior_state_variables(jn)%name, trn(:,:,:,jp_fabm_m1+jn))
95
96         ! Save depth integral if selected for output in XIOS
97         IF (iom_use(TRIM(model%interior_state_variables(jn)%name)//'_VINT')) THEN
98            vint = 0._wp
99            DO jk = 1, jpkm1
100               vint = vint + trn(:,:,jk,jp_fabm_m1+jn) * fse3t(:,:,jk) * tmask(:,:,jk)
101            END DO
102            CALL iom_put(TRIM(model%interior_state_variables(jn)%name)//'_VINT', vint)
103         END IF
104      END DO
105      DO jn = 1, jp_fabm_surface
106         CALL iom_put( model%surface_state_variables(jn)%name, fabm_st2dn(:,:,jn) )
107      END DO
108      DO jn = 1, jp_fabm_bottom
109         CALL iom_put( model%bottom_state_variables(jn)%name, fabm_st2dn(:,:,jp_fabm_surface+jn) )
110      END DO
111
112      ! write 3D diagnostics in the file
113      ! ---------------------------------------
114      DO jn = 1, size(model%diagnostic_variables)
115         IF (model%diagnostic_variables(jn)%save) &
116             CALL iom_put( model%diagnostic_variables(jn)%name, fabm_get_bulk_diagnostic_data(model,jn))
117      END DO
118
119      ! write 2D diagnostics in the file
120      ! ---------------------------------------
121      DO jn = 1, size(model%horizontal_diagnostic_variables)
122         IF (model%horizontal_diagnostic_variables(jn)%save) &
123             CALL iom_put( model%horizontal_diagnostic_variables(jn)%name, fabm_get_horizontal_diagnostic_data(model,jn))
124      END DO
125      !
126      CALL trc_sms_fabm_check_mass
127
128   END SUBROUTINE wri_fabm
129
130#else
131   !!----------------------------------------------------------------------
132   !!  Dummy module :                                     No passive tracer
133   !!----------------------------------------------------------------------
134   INTERFACE trc_wri_fabm
135       MODULE PROCEDURE wri_fabm,wri_fabm_fl
136   END INTERFACE trc_wri_fabm
137
138   PUBLIC trc_wri_fabm
139
140   CONTAINS
141
142   SUBROUTINE wri_fabm_fl(kt,fl)
143      INTEGER, INTENT( in )               :: fl
144      INTEGER, INTENT( in )               :: kt
145   END SUBROUTINE wri_fabm_fl
146
147   SUBROUTINE wri_fabm(kt)                 ! Empty routine 
148      INTEGER, INTENT( in )               :: kt
149   END SUBROUTINE wri_fabm
150
151#endif
152
153   !!----------------------------------------------------------------------
154   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
155   !! $Id$
156   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
157   !!======================================================================
158END MODULE trcwri_fabm
Note: See TracBrowser for help on using the repository browser.