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

source: NEMO/branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90 @ 9709

Last change on this file since 9709 was 9709, checked in by cetlod, 6 years ago

Update diasub branche
File size: 6.7 KB
Line 
1!! 18 SEP 2016 : DC
2MODULE trcwri_pisces
3   !!======================================================================
4   !!                       *** MODULE trcwri ***
5   !!    PISCES :   Output of PISCES tracers
6   !!======================================================================
7   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
8   !!----------------------------------------------------------------------
9#if defined key_top && defined key_iomput && ( defined key_pisces || defined key_pisces_reduced )
10   !!----------------------------------------------------------------------
11   !!   'key_pisces or key_pisces_reduced'                     PISCES model
12   !!----------------------------------------------------------------------
13   !! trc_wri_pisces   :  outputs of concentration fields
14   !!----------------------------------------------------------------------
15   USE trc         ! passive tracers common variables
16   USE sms_pisces  ! PISCES variables
17   USE iom         ! I/O manager
18   USE diasub
19   USE trcdiasub
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC trc_wri_pisces 
25
26#  include "top_substitute.h90"
27CONTAINS
28
29   SUBROUTINE trc_wri_pisces
30      !!---------------------------------------------------------------------
31      !!                     ***  ROUTINE trc_wri_trc  ***
32      !!
33      !! ** Purpose :   output passive tracers fields
34      !!---------------------------------------------------------------------
35      CHARACTER (len=20)   :: cltra
36      REAL(wp)             :: zrfact
37      INTEGER              :: jn
38      !!---------------------------------------------------------------------
39 
40      ! write the tracer concentrations in the file
41      ! ---------------------------------------
42#if defined key_pisces_reduced
43      DO jn = jp_pcs0, jp_pcs1
44         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
45         IF( lk_vvl ) THEN
46            CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) )
47         ELSE
48            CALL iom_put( cltra, trn(:,:,:,jn) )
49         ENDIF
50      END DO
51#else
52      DO jn = jp_pcs0, jp_pcs1
53         zrfact = 1.0e+6 
54         IF( jn == jpno3 .OR. jn == jpnh4 ) zrfact = rno3 * 1.0e+6 
55         IF( jn == jppo4  )                 zrfact = po4r * 1.0e+6
56         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
57         IF( lk_vvl ) THEN
58            CALL iom_put( cltra, trn(:,:,:,jn) * fse3t_n(:,:,:) * zrfact )
59         ELSE
60            CALL iom_put( cltra, trn(:,:,:,jn) * zrfact )
61         ENDIF
62      END DO
63#endif
64      CALL trc_wri_sub !!! WORK DC
65      !
66   END SUBROUTINE trc_wri_pisces
67
68# if defined key_diasub
69
70   SUBROUTINE trc_wri_sub
71      !!----------------------------------------------------------------------
72      !!                     ***  ROUTINE trc_wri_sub  ***
73      !!
74      !! ** Purpose :   output of passive tracer : advection-diffusion  subduction subduction
75      !!
76      !!----------------------------------------------------------------------
77      CHARACTER(len=8), DIMENSION(jptrsub)   :: cltra1
78      CHARACTER(len=20)  :: cltra, cltra2
79      INTEGER            :: jn, jl, ji, jj, ik
80      REAL(wp), DIMENSION(jpi,jpj)         :: zsed
81      REAL(wp), DIMENSION(jpi,jpj,jptrsub) :: ztrsubtpoc
82      !!----------------------------------------------------------------------
83
84      DO jl = 1, jptrsub
85         IF( jl == jpsub_xad ) cltra1(jl) = TRIM("xad_sub_")   ! x advection for tracer
86         IF( jl == jpsub_yad ) cltra1(jl) = TRIM("yad_sub_")   ! y advection for tracer
87         IF( jl == jpsub_zad ) cltra1(jl) = TRIM("zad_sub_")   ! z advection for tracer
88         IF( jl == jpsub_mld ) cltra1(jl) = TRIM("mld_sub_")   ! mld for tracer
89         IF( jl == jpsub_xlf ) cltra1(jl) = TRIM("xlf_sub_")   ! x lateral diffusion for tracer
90         IF( jl == jpsub_ylf ) cltra1(jl) = TRIM("ylf_sub_")   ! y lateral diffusion for tracer
91         IF( jl == jpsub_zlf ) cltra1(jl) = TRIM("zlf_sub_")   ! z lateral diffusion for tracer
92         IF( jl == jpsub_zdf ) cltra1(jl) = TRIM("zdf_sub_")   ! z vertical diffusion for tracer
93#if defined key_trcldf_eiv
94         IF( jl == jpsub_xei ) cltra1(jl) = TRIM("xei_sub_")   ! x gent velocity for tracer
95         IF( jl == jpsub_yei ) cltra1(jl) = TRIM("yei_sub_")   ! y gent velocity for tracer
96         IF( jl == jpsub_zei ) cltra1(jl) = TRIM("zei_sub_")   ! z gent velocity for tracer
97#endif
98     ENDDO
99     !
100# if defined key_pisces
101     DO jl = 1, jptrsub
102        ! write the trends
103        DO jn = 1, jptra
104           IF(     jn == jpdic .OR. jn == jptal .OR. jn == jpoxy .OR. jn == jpdoc .OR. jn == jpcal  &
105            & .OR. jn == jpno3 .OR. jn == jppo4 .OR. jn == jpsil .OR. jn == jpfer .OR. jn == jpnh4 ) THEN
106              cltra = TRIM(cltra1(jl))//TRIM(ctrcnm(jn))
107              CALL iom_put( cltra, trsub(:,:,jn,jl) )
108           ENDIF
109        END DO
110        !
111        ! Sum of subduction of phy, phy2, zoo, zoo2, POC et GOC
112        ztrsubtpoc(:,:,jl) = trsub(:,:,jpphy,jl) + trsub(:,:,jpdia,jl)  &
113           &               + trsub(:,:,jpzoo,jl) + trsub(:,:,jpmes,jl)  &
114           &               + trsub(:,:,jppoc,jl) + trsub(:,:,jpgoc,jl)
115        cltra2 = "TOC"
116        cltra  = TRIM(cltra1(jl))//TRIM(cltra2)
117        CALL iom_put( cltra, ztrsubtpoc(:,:,jl))
118     END DO
119
120     ! Sedimentation a la base de la couche de mélane
121     cltra = TRIM("sedsed")
122     DO jj = 1, jpj
123        DO ji = 1, jpi
124           ik = nmln(ji,jj)
125           zsed(ji,jj) = ( sinking(ji,jj,ik) + sinking2(ji,jj,ik) ) * tmask(ji,jj,ik)
126        END DO
127     END DO
128     CALL iom_put( cltra, zsed(:,:) )
129#else
130     DO jl = 1, jptrsub
131        ! write the trends
132        DO jn = 1, jptra
133             cltra = TRIM(cltra1(jl))//TRIM(ctrcnm(jn))
134             CALL iom_put( cltra, trsub(:,:,jn,jl) )
135        END DO
136        !
137     END DO
138#endif
139      !
140      ! une fois ecrit, trsub est remis a 0
141      DO jl = 1, jptrsub
142         DO jn = 1, jptra
143            trsub(:,:,jn,jl) = 0.
144         END DO
145      END DO
146      !
147   END SUBROUTINE trc_wri_sub
148
149# else
150   SUBROUTINE trc_wri_sub                      ! Dummy routine
151   END SUBROUTINE trc_wri_sub
152# endif
153
154
155#else
156   !!----------------------------------------------------------------------
157   !!  Dummy module :                                     No passive tracer
158   !!----------------------------------------------------------------------
159   PUBLIC trc_wri_pisces
160CONTAINS
161   SUBROUTINE trc_wri_pisces                     ! Empty routine 
162   END SUBROUTINE trc_wri_pisces
163#endif
164
165   !!----------------------------------------------------------------------
166   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
167   !! $Id: trcwri_pisces.F90 3160 2011-11-20 14:27:18Z cetlod $
168   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
169   !!======================================================================
170END MODULE trcwri_pisces
Note: See TracBrowser for help on using the repository browser.