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.F90 in NEMO/branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC – NEMO

source: NEMO/branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/trcwri.F90 @ 10278

Last change on this file since 10278 was 6570, checked in by cetlod, 8 years ago

1st implementation of subduction diag

  • Property svn:keywords set to Id
File size: 6.9 KB
Line 
1MODULE trcwri
2   !!======================================================================
3   !!                       *** MODULE trcwri ***
4   !!    TOP :   Output of passive tracers
5   !!======================================================================
6   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
7   !!----------------------------------------------------------------------
8#if defined key_top && defined key_iomput
9   !!----------------------------------------------------------------------
10   !!   'key_top'                                           TOP models
11   !!----------------------------------------------------------------------
12   !! trc_wri_trc   :  outputs of concentration fields
13   !!----------------------------------------------------------------------
14   USE dom_oce     ! ocean space and time domain variables
15   USE oce_trc     ! shared variables between ocean and passive tracers
16   USE trc         ! passive tracers common variables
17   USE iom         ! I/O manager
18   USE dianam      ! Output file name
19   USE trcwri_pisces
20   USE trcwri_cfc
21   USE trcwri_c14b
22   USE trcwri_age
23   USE trcwri_my_trc
24   USE diasub
25   USE trcdiasub
26
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC trc_wri     
32
33   !! * Substitutions
34#  include "top_substitute.h90"
35
36CONTAINS
37
38   SUBROUTINE trc_wri( kt )
39      !!---------------------------------------------------------------------
40      !!                     ***  ROUTINE trc_wri  ***
41      !!
42      !! ** Purpose :   output passive tracers fields and dynamical trends
43      !!---------------------------------------------------------------------
44      INTEGER, INTENT( in )     :: kt
45      !
46      INTEGER                   :: jn
47      CHARACTER (len=20)        :: cltra
48      CHARACTER (len=40)        :: clhstnam
49      INTEGER ::   inum = 11            ! temporary logical unit
50      !!---------------------------------------------------------------------
51      !
52      IF( nn_timing == 1 )  CALL timing_start('trc_wri')
53      !
54      IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro
55         CALL dia_nam( clhstnam, nn_writetrc,' ' )
56         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
57         WRITE(inum,*) clhstnam
58         CLOSE(inum)
59      ENDIF
60      ! write the tracer concentrations in the file
61      ! ---------------------------------------
62      IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES
63      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
64      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14
65      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer
66      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
67      !
68      IF( lk_diasub  )   CALL trc_wri_sub        ! Subduction diagnostics
69      !
70      IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
71      !
72   END SUBROUTINE trc_wri
73
74# if defined key_diasub
75
76   SUBROUTINE trc_wri_sub
77      !!----------------------------------------------------------------------
78      !!                     ***  ROUTINE trc_wri_sub  ***
79      !!
80      !! ** Purpose :   output of passive tracer : advection-diffusion  subduction subduction
81      !!
82      !!----------------------------------------------------------------------
83      CHARACTER(len=8), DIMENSION(jptrsub)   :: cltra1
84      CHARACTER(len=20)  :: cltra, cltra2
85      INTEGER            :: jn, jl, ji, jj, ik
86      REAL(wp), DIMENSION(jpi,jpj)         :: zsed
87      REAL(wp), DIMENSION(jpi,jpj,jptrsub) :: ztrsubtpoc
88      !!----------------------------------------------------------------------
89
90      DO jl = 1, jptrsub
91         IF( jl == jpsub_xad ) cltra1(jl) = TRIM("xad_sub_")   ! x advection for tracer
92         IF( jl == jpsub_yad ) cltra1(jl) = TRIM("yad_sub_")   ! y advection for tracer
93         IF( jl == jpsub_zad ) cltra1(jl) = TRIM("zad_sub_")   ! z advection for tracer
94         IF( jl == jpsub_mld ) cltra1(jl) = TRIM("mld_sub_")   ! mld for tracer
95         IF( jl == jpsub_xlf ) cltra1(jl) = TRIM("xlf_sub_")   ! x lateral diffusion for tracer
96         IF( jl == jpsub_ylf ) cltra1(jl) = TRIM("ylf_sub_")   ! y lateral diffusion for tracer
97         IF( jl == jpsub_zlf ) cltra1(jl) = TRIM("zlf_sub_")   ! z lateral diffusion for tracer
98         IF( jl == jpsub_zdf ) cltra1(jl) = TRIM("zdf_sub_")   ! z vertical diffusion for tracer
99#if defined key_trcldf_eiv
100         IF( jl == jpsub_xei ) cltra1(jl) = TRIM("xei_sub_")   ! x gent velocity for tracer
101         IF( jl == jpsub_yei ) cltra1(jl) = TRIM("yei_sub_")   ! y gent velocity for tracer
102         IF( jl == jpsub_zei ) cltra1(jl) = TRIM("zei_sub_")   ! z gent velocity for tracer
103#endif
104     ENDDO
105     !
106# if defined key_pisces
107     DO jl = 1, jptrsub
108        ! write the trends
109        DO jn = 1, jptra
110           IF(     jn == jpdic .OR. jn == jptal .OR. jn == jpoxy .OR. jn == jpdoc .OR. jn == jpcal  &
111            & .OR. jn == jpno3 .OR. jn == jppo4 .OR. jn == jpsil .OR. jn == jpfer .OR. jn == jpnh4 ) THEN
112              cltra = TRIM(cltra1(jl))//TRIM(ctrcnm(jn))
113              CALL iom_put( cltra, trsub(:,:,jn,jl) )
114           ENDIF
115        END DO
116        !
117        ! Sum of subduction of phy, phy2, zoo, zoo2, POC et GOC
118        ztrsubtpoc(:,:,jl) = trsub(:,:,jpphy,jl) + trsub(:,:,jpdia,jl)  &
119           &               + trsub(:,:,jpzoo,jl) + trsub(:,:,jpmes,jl)  &
120           &               + trsub(:,:,jppoc,jl) + trsub(:,:,jpgoc,jl)
121        cltra2 = "TOC"
122        cltra  = TRIM(cltra1(jl))//TRIM(cltra2)
123        CALL iom_put( cltra, ztrsubtpoc(:,:,jl))
124     END DO
125
126     ! Sedimentation a la base de la couche de mélane
127     cltra = TRIM("sedsed")
128     DO jj = 1, jpj
129        DO ji = 1, jpi
130           ik = nmln(ji,jj)
131           zsed(ji,jj) = ( sinking(ji,jj,ik) + sinking2(ji,jj,ik) ) * tmask(ji,jj,ik)
132        END DO
133     END DO
134     CALL iom_put( cltra, zsed(:,:) )
135#else
136     DO jl = 1, jptrsub
137        ! write the trends
138        DO jn = 1, jptra
139             cltra = TRIM(cltra1(jl))//TRIM(ctrcnm(jn))
140             CALL iom_put( cltra, trsub(:,:,jn,jl) )
141        END DO
142        !
143     END DO
144#endif
145      !
146      ! une fois ecrit, trsub est remis a 0
147      DO jl = 1, jptrsub
148         DO jn = 1, jptra
149            trsub(:,:,jn,jl) = 0.
150         END DO
151      END DO
152      !
153   END SUBROUTINE trc_wri_sub
154
155# endif
156
157#else
158   !!----------------------------------------------------------------------
159   !!  Dummy module :                                     No passive tracer
160   !!----------------------------------------------------------------------
161   PUBLIC trc_wri
162CONTAINS
163   SUBROUTINE trc_wri( kt )                     ! Empty routine   
164   INTEGER, INTENT(in) :: kt
165   END SUBROUTINE trc_wri
166#endif
167
168   !!----------------------------------------------------------------------
169   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
170   !! $Id$
171   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
172   !!======================================================================
173END MODULE trcwri
Note: See TracBrowser for help on using the repository browser.