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/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/FABM – NEMO

source: branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90 @ 11137

Last change on this file since 11137 was 11137, checked in by jcastill, 5 years ago

Add missing files

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  !  2009-05 (C. Ethe)  Original code
7   !!----------------------------------------------------------------------
8#if defined key_top && key_fabm && defined key_iomput
9   !!----------------------------------------------------------------------
10   !!   'key_fabm'                                           FABM model
11   !!----------------------------------------------------------------------
12   !! trc_wri_fabm   :  outputs of concentration fields
13   !!----------------------------------------------------------------------
14   USE trc         ! passive tracers common variables
15   USE iom         ! I/O manager
16   USE trdtrc_oce
17   USE trcsms_fabm, only: trc_sms_fabm_check_mass
18   USE par_fabm
19   USE st2d_fabm
20   USE fabm, only: fabm_get_bulk_diagnostic_data, fabm_get_horizontal_diagnostic_data
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
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_fabm1
61        IF(ln_trdtrc (jn))THEN
62         trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm0+jn-1)*fse3t_a(:,:,:) + &
63                             tr_temp(:,:,:,jn)*fse3t(:,:,:) )
64         cltra = TRIM( model%state_variables(jn)%name )//"_e3t"     ! depth integrated output
65         IF( kt == nittrc000 ) write(6,*)'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
83     
84      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: zw3d
85
86#if defined key_tracer_budget
87      IF( kt == nittrc000 ) THEN
88         ALLOCATE(tr_temp(jpi,jpj,jpk,jp_fabm),fabm_st2d_temp(jpi,jpj,jp_fabm_surface+jp_fabm_bottom))
89      ENDIF
90      tr_temp(:,:,:,:)=trn(:,:,:,jp_fabm0:jp_fabm1) ! slwa save for tracer budget (unfiltered trn)
91      fabm_st2d_temp(:,:,:)=fabm_st2dn(:,:,:)
92#endif
93      DO jn = 1, jp_fabm
94         CALL iom_put( model%state_variables(jn)%name, trn(:,:,:,jp_fabm0+jn-1) )
95      END DO
96      DO jn = 1, jp_fabm_surface
97         CALL iom_put( model%surface_state_variables(jn)%name, fabm_st2dn(:,:,jn) )
98      END DO
99      DO jn = 1, jp_fabm_bottom
100         CALL iom_put( model%bottom_state_variables(jn)%name, fabm_st2dn(:,:,jp_fabm_surface+jn) )
101      END DO
102
103      ! write 3D diagnostics in the file
104      ! ---------------------------------------
105      DO jn = 1, size(model%diagnostic_variables)
106         IF (model%diagnostic_variables(jn)%save) &
107             CALL iom_put( model%diagnostic_variables(jn)%name, fabm_get_bulk_diagnostic_data(model,jn))
108      END DO
109      zw3d(:,:,:) = visib(:,:,:)*tmask(:,:,:) + 1.e+20*(1.0-tmask(:,:,:))
110      CALL iom_put( 'visib', zw3d )
111
112      ! write 2D diagnostics in the file
113      ! ---------------------------------------
114      DO jn = 1, size(model%horizontal_diagnostic_variables)
115         IF (model%horizontal_diagnostic_variables(jn)%save) &
116             CALL iom_put( model%horizontal_diagnostic_variables(jn)%name, fabm_get_horizontal_diagnostic_data(model,jn))
117      END DO
118      !
119      CALL trc_sms_fabm_check_mass
120
121   END SUBROUTINE wri_fabm
122
123#else
124   !!----------------------------------------------------------------------
125   !!  Dummy module :                                     No passive tracer
126   !!----------------------------------------------------------------------
127   PUBLIC trc_wri_fabm
128CONTAINS
129   SUBROUTINE trc_wri_fabm                     ! Empty routine 
130   END SUBROUTINE trc_wri_fabm
131#endif
132
133   !!----------------------------------------------------------------------
134   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
135   !! $Id$
136   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
137   !!======================================================================
138END MODULE trcwri_fabm
Note: See TracBrowser for help on using the repository browser.