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.
trcsbcssr.F90 in branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbcssr.F90 @ 8144

Last change on this file since 8144 was 8144, checked in by dford, 7 years ago

Remove debug print statements.
File size: 7.7 KB
Line 
1MODULE trcsbcssr
2   !!======================================================================
3   !!                       ***  MODULE  trcsbcssr  ***
4   !! Surface module :  restoring term towards surface chlorophyll climatology
5   !!======================================================================
6   !! History :  3.6  !  2017-06  (D. Ford)  Adapt from sbcssr.F90
7   !!----------------------------------------------------------------------
8#if defined key_top
9   !!----------------------------------------------------------------------
10   !!   trc_sbc_ssr       : add a restoring term toward chl climatology
11   !!   trc_sbc_ssr_init  : initialisation of surface restoring
12   !!----------------------------------------------------------------------
13   USE dom_oce        ! ocean space and time domain
14   USE oce_trc       !  shared variables between ocean and passive tracers
15   USE trc
16   USE trcnam_trp
17   !
18   USE fldread        ! read input fields
19   USE iom            ! I/O manager
20   USE in_out_manager ! I/O manager
21   USE lib_mpp        ! distribued memory computing library
22   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
23   USE timing         ! Timing
24   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
25#if defined key_fabm
26   USE par_fabm
27#endif
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   trc_sbc_ssr        ! routine called in trctrp
33
34   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chldmp   ! structure of input Chl (file informations, fields read)
35
36   !! * Substitutions
37#  include "top_substitute.h90"
38
39CONTAINS
40
41   SUBROUTINE trc_sbc_ssr( kt )
42      !!---------------------------------------------------------------------
43      !!                     ***  ROUTINE trc_sbc_ssr  ***
44      !!
45      !! ** Purpose :   Add to chlorophyll a damping term
46      !!                toward chlorophyll climatology
47      !!
48      !! ** Method  : - Read chlorophyll climatology
49      !!              - at each trc time step add term to each PFT
50      !!                   surface only    (nn_chldmp = 1)
51      !!                   mixed layer     (nn_chldmp = 2)
52      !!---------------------------------------------------------------------
53      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
54      !!
55      INTEGER  ::   ji, jj, jk   ! dummy loop indices
56 
57      REAL(wp), DIMENSION(jpi,jpj) :: ztra, zchl
58      REAL(wp)                     :: zpft
59      !!----------------------------------------------------------------------
60      !
61      IF( nn_timing == 1 )  CALL timing_start('trc_sbc_ssr')
62      !
63      IF( kt == nittrc000 )  THEN
64         !
65         CALL trc_sbc_ssr_init
66         !
67         IF( nn_chldmp > 0 ) THEN
68            !
69            IF (lwp) WRITE(numout,*) 'Damping chlorophyll on timestep ', kt
70            !
71            CALL fld_read( kt, 1, sf_chldmp )   ! Read Chl data and provides it at kt
72            !
73#if defined key_fabm
74            zchl(:,:) = trb(:,:,1,jp_fabm_m1+jp_fabm_chl1) + &
75               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &
76               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl3) + &
77               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl4)
78            ztra(:,:) = rn_chldmp * ( sf_chldmp(1)%fnow(:,:,1) - zchl(:,:) )
79            !
80            DO jj = 2, jpjm1
81               DO ji = fs_2, fs_jpim1   ! vector opt.
82                  IF ( ( sf_chldmp(1)%fnow(ji,jj,1) >   0.0 ) .AND. &
83                     & ( sf_chldmp(1)%fnow(ji,jj,1) < 100.0 ) .AND. &
84                     & ( zchl(ji,jj)                >   0.0 ) ) THEN
85                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / zchl(ji,jj) ) * ztra(ji,jj)
86                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + zpft
87                     IF( nn_chldmp == 2 ) THEN
88                        DO jk = 2, jpkm1
89                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
90                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) + zpft
91                           ENDIF
92                        END DO
93                     ENDIF
94                     !
95                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / zchl(ji,jj) ) * ztra(ji,jj)
96                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + zpft
97                     IF( nn_chldmp == 2 ) THEN
98                        DO jk = 2, jpkm1
99                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
100                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) + zpft
101                           ENDIF
102                        END DO
103                     ENDIF
104                     !
105                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / zchl(ji,jj) ) * ztra(ji,jj)
106                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + zpft
107                     IF( nn_chldmp == 2 ) THEN
108                        DO jk = 2, jpkm1
109                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
110                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) + zpft
111                           ENDIF
112                        END DO
113                     ENDIF
114                     !
115                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / zchl(ji,jj) ) * ztra(ji,jj)
116                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) + zpft
117                     IF( nn_chldmp == 2 ) THEN
118                        DO jk = 2, jpkm1
119                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN
120                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) + zpft
121                           ENDIF
122                        END DO
123                     ENDIF
124                  ENDIF
125               END DO
126            END DO
127#else
128            CALL ctl_stop( 'STOP', 'trc_sbc_ssr: only works with FABM-ERSEM' )
129#endif
130            !
131         ENDIF
132         !
133      ENDIF
134      !
135      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc_ssr')
136      !
137   END SUBROUTINE trc_sbc_ssr
138
139 
140   SUBROUTINE trc_sbc_ssr_init
141      !!---------------------------------------------------------------------
142      !!                  ***  ROUTINE trc_sbc_ssr_init  ***
143      !!
144      !! ** Purpose :   initialisation of surface damping term
145      !!
146      !! ** Method  : - Read chlorophyll
147      !!---------------------------------------------------------------------
148      INTEGER  ::   ierror   ! return error code
149      !!----------------------------------------------------------------------
150      !
151      IF( nn_chldmp > 0 ) THEN      !* set sf_sss structure & allocate arrays
152         !
153         ALLOCATE( sf_chldmp(1), STAT=ierror )
154         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp structure' )
155         ALLOCATE( sf_chldmp(1)%fnow(jpi,jpj,1), STAT=ierror )
156         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp now array' )
157         !
158         ! fill sf_sss with sn_sss and control print
159         CALL fld_fill( sf_chldmp, (/ sn_chldmp /), cn_dir_chldmp, 'trc_sbc_ssr', 'Chl restoring term', 'namtrc_dmp' )
160         IF( sf_chldmp(1)%ln_tint )   ALLOCATE( sf_chldmp(1)%fdta(jpi,jpj,1,2), STAT=ierror )
161         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp data array' )
162         !
163      ENDIF
164      !
165   END SUBROUTINE trc_sbc_ssr_init
166
167#else
168   SUBROUTINE trc_sbc_ssr( kt )        ! Empty routine
169      INTEGER, INTENT(in) :: kt
170      WRITE(*,*) 'trc_sbc_ssr: You should not have seen this print! error?', kt
171   END SUBROUTINE trc_sbc_ssr
172#endif
173   !!======================================================================
174END MODULE trcsbcssr
Note: See TracBrowser for help on using the repository browser.