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 @ 2927

Last change on this file since 2927 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
RevLine 
[935]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         !
[1119]16   USE trc
[1073]17   USE sms_pisces
[935]18   
19   USE p4zint          !
20   USE p4zche          !
21   USE p4zbio          !
[2528]22   USE p4zsink         !
23   USE p4zopt          !
24   USE p4zlim          !
25   USE p4zprod         !
26   USE p4zmort         !
27   USE p4zmicro        !
28   USE p4zmeso         !
29   USE p4zrem          !
[935]30   USE p4zsed          !
31   USE p4zlys          !
32   USE p4zflx          !
33
[2528]34   USE prtctl_trc
[1255]35
[2528]36   USE trdmod_oce
37   USE trdmod_trc
38
[1185]39   USE sedmodel
40
[935]41   IMPLICIT NONE
42   PRIVATE
43
44   PUBLIC   trc_sms_pisces    ! called in trcsms.F90
45
46   !!----------------------------------------------------------------------
[2528]47   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1152]48   !! $Id$
[2528]49   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[935]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      !!---------------------------------------------------------------------
[2715]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      !
[935]68      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
69      !!
70      INTEGER ::   jnt, jn
[2528]71      CHARACTER (len=25) :: charout
[935]72      !!---------------------------------------------------------------------
73
[2528]74      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only)
[1287]75
[2715]76      IF( wrk_in_use(3,1) )  THEN
77        CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.')  ;  RETURN
78      ENDIF
79
[2528]80      IF( ndayflxtr /= nday_year ) THEN      ! New days
[935]81         !
[2528]82         ndayflxtr = nday_year
[935]83
[2528]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
[935]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
[1185]110
[2528]111
[1255]112      IF( l_trdtrc ) THEN
113          DO jn = jp_pcs0, jp_pcs1
114            ztrpis(:,:,:) = tra(:,:,:,jn)
[2528]115            CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends
[1255]116          END DO
[2715]117          DEALLOCATE( ztrpis )
[1255]118      END IF
119
[1287]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
[1185]129
[2715]130      IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.') 
131
[1287]132   END SUBROUTINE trc_sms_pisces
[1185]133
[1287]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
[2528]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
[1287]158            END DO
159         END DO
[2528]160         !
161      END IF
[1185]162
[2528]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
[1287]180   END SUBROUTINE trc_sms_pisces_init
[1185]181
[935]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.