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.
trcsms_pisces.F90 in trunk/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk

  • Property svn:keywords set to Id
File size: 7.0 KB
Line 
1MODULE trcsms_pisces
2   !!======================================================================
3   !!                         ***  MODULE trcsms_pisces  ***
4   !! TOP :   PISCES Source Minus Sink manager
5   !!======================================================================
6   !! History :   1.0  !  2004-03 (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!----------------------------------------------------------------------
9#if defined key_pisces
10   !!----------------------------------------------------------------------
11   !!   'key_pisces'                                       PISCES bio-model
12   !!----------------------------------------------------------------------
13   !!   trcsms_pisces        :  Time loop of passive tracers sms
14   !!----------------------------------------------------------------------
15   USE oce_trc         !
16   USE trc
17   USE sms_pisces
18   
19   USE p4zint          !
20   USE p4zche          !
21   USE p4zbio          !
22   USE p4zsink         !
23   USE p4zopt          !
24   USE p4zlim          !
25   USE p4zprod         !
26   USE p4zmort         !
27   USE p4zmicro        !
28   USE p4zmeso         !
29   USE p4zrem          !
30   USE p4zsed          !
31   USE p4zlys          !
32   USE p4zflx          !
33
34   USE prtctl_trc
35
36   USE trdmod_oce
37   USE trdmod_trc
38
39   USE sedmodel
40
41   IMPLICIT NONE
42   PRIVATE
43
44   PUBLIC   trc_sms_pisces    ! called in trcsms.F90
45
46   !!----------------------------------------------------------------------
47   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
48   !! $Id$
49   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51
52CONTAINS
53
54   SUBROUTINE trc_sms_pisces( kt )
55      !!---------------------------------------------------------------------
56      !!                     ***  ROUTINE trc_sms_pisces  ***
57      !!
58      !! ** Purpose :   Managment of the call to Biological sources and sinks
59      !!              routines of PISCES bio-model
60      !!
61      !! ** Method  : - at each new day ...
62      !!              - several calls of bio and sed ???
63      !!              - ...
64      !!---------------------------------------------------------------------
65      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
66      USE wrk_nemo, ONLY: ztrpis => wrk_3d_1   ! used for pisces sms trends
67      !
68      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
69      !!
70      INTEGER ::   jnt, jn
71      CHARACTER (len=25) :: charout
72      !!---------------------------------------------------------------------
73
74      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only)
75
76      IF( wrk_in_use(3,1) )  THEN
77        CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.')  ;  RETURN
78      ENDIF
79
80      IF( ndayflxtr /= nday_year ) THEN      ! New days
81         !
82         ndayflxtr = nday_year
83
84         IF(lwp) write(numout,*)
85         IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year
86         IF(lwp) write(numout,*) '~~~~~~'
87
88         CALL p4z_che          ! computation of chemical constants
89         CALL p4z_int          ! computation of various rates for biogeochemistry
90         !
91      ENDIF
92
93      DO jnt = 1, nrdttrc          ! Potential time splitting if requested
94         !
95         CALL p4z_bio (kt, jnt)    ! Compute soft tissue production (POC)
96         CALL p4z_sed (kt, jnt)    ! compute soft tissue remineralisation
97         !
98         trb(:,:,:,:) = trn(:,:,:,:)
99         !
100      END DO
101
102      CALL p4z_lys( kt )             ! Compute CaCO3 saturation
103      CALL p4z_flx( kt )             ! Compute surface fluxes
104
105      DO jn = jp_pcs0, jp_pcs1
106        CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
107        CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
108        CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
109      END DO
110
111
112      IF( l_trdtrc ) THEN
113          DO jn = jp_pcs0, jp_pcs1
114            ztrpis(:,:,:) = tra(:,:,:,jn)
115            CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends
116          END DO
117          DEALLOCATE( ztrpis )
118      END IF
119
120      IF( lk_sed ) THEN 
121         !
122         CALL sed_model( kt )     !  Main program of Sediment model
123         !
124         DO jn = jp_pcs0, jp_pcs1
125           CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
126         END DO
127         !
128      ENDIF
129
130      IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.') 
131
132   END SUBROUTINE trc_sms_pisces
133
134   SUBROUTINE trc_sms_pisces_init
135      !!----------------------------------------------------------------------
136      !!                  ***  ROUTINE trc_sms_pisces_init  ***
137      !!
138      !! ** Purpose :   Initialization of PH variable
139      !!
140      !!----------------------------------------------------------------------
141      INTEGER  ::  ji, jj, jk
142      REAL(wp) ::  zcaralk, zbicarb, zco3
143      REAL(wp) ::  ztmas, ztmas1
144
145      IF( .NOT. ln_rsttr ) THEN
146         ! Initialization of chemical variables of the carbon cycle
147         ! --------------------------------------------------------
148         DO jk = 1, jpk
149            DO jj = 1, jpj
150               DO ji = 1, jpi
151                  ztmas   = tmask(ji,jj,jk)
152                  ztmas1  = 1. - tmask(ji,jj,jk)
153                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
154                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
155                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
156                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
157               END DO
158            END DO
159         END DO
160         !
161      END IF
162
163      ! Time step duration for biology
164      xstep = rfact2 / rday
165
166      CALL p4z_sink_init      ! vertical flux of particulate organic matter
167      CALL p4z_opt_init       ! Optic: PAR in the water column
168      CALL p4z_lim_init       ! co-limitations by the various nutrients
169      CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.
170      CALL p4z_rem_init       ! remineralisation
171      CALL p4z_mort_init      ! phytoplankton mortality
172      CALL p4z_micro_init     ! microzooplankton
173      CALL p4z_meso_init      ! mesozooplankton
174      CALL p4z_sed_init       ! sedimentation
175      CALL p4z_lys_init       ! calcite saturation
176      CALL p4z_flx_init       ! gas exchange
177
178      ndayflxtr = 0
179
180   END SUBROUTINE trc_sms_pisces_init
181
182#else
183   !!======================================================================
184   !!  Dummy module :                                   No PISCES bio-model
185   !!======================================================================
186CONTAINS
187   SUBROUTINE trc_sms_pisces( kt )                   ! Empty routine
188      INTEGER, INTENT( in ) ::   kt
189      WRITE(*,*) 'trc_sms_pisces: You should not have seen this print! error?', kt
190   END SUBROUTINE trc_sms_pisces
191#endif 
192
193   !!======================================================================
194END MODULE trcsms_pisces 
Note: See TracBrowser for help on using the repository browser.