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.
trcini_c14b.F90 in branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/TOP_SRC/C14b – NEMO

source: branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90 @ 5500

Last change on this file since 5500 was 5500, checked in by dancopsey, 9 years ago

Removed SVN keywords.

File size: 7.8 KB
Line 
1MODULE trcini_c14b
2   !!======================================================================
3   !!                         ***  MODULE trcini_c14b  ***
4   !! TOP :   initialisation of the C14 bomb tracer
5   !!======================================================================
6   !! History :  1.0  ! 2005-10  (Z. Lachkar) Original code
7   !!            2.0  ! 2007-12  (C. Ethe)
8   !!----------------------------------------------------------------------
9#if defined key_c14b
10   !!----------------------------------------------------------------------
11   !!   'key_c14b'                                          C14 bomb tracer
12   !!----------------------------------------------------------------------
13   !! trc_ini_c14b      : C14 model initialisation
14   !!----------------------------------------------------------------------
15   USE oce_trc         ! Ocean variables
16   USE par_trc         ! TOP parameters
17   USE trc             ! TOP variables
18   USE trcsms_c14b     ! C14 sms trends
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   trc_ini_c14b   ! called by trcini.F90 module
24
25   !                             ! With respect to data file !!
26   INTEGER  ::   jpybeg = 1765   ! starting year for C14
27   INTEGER  ::   jpyend = 2002   ! ending year for C14
28   INTEGER  ::   nrec            ! number of year in CO2 Concentrations file
29   INTEGER  ::   nmaxrec 
30   INTEGER  ::   inum1, inum2    ! unit number
31
32   REAL(wp) ::   ys40 = -40.     ! 40 degrees south
33   REAL(wp) ::   ys20 = -20.     ! 20 degrees south
34   REAL(wp) ::   yn20 =  20.     ! 20 degrees north
35   REAL(wp) ::   yn40 =  40.     ! 40 degrees north
36
37   !!----------------------------------------------------------------------
38   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE trc_ini_c14b
45      !!-------------------------------------------------------------------
46      !!                     ***  trc_ini_c14b  *** 
47      !!
48      !! ** Purpose :   initialization for C14 model
49      !!
50      !!----------------------------------------------------------------------
51      INTEGER  ::   ji, jj, jl, jm
52      REAL(wp) ::   zyear
53      !!----------------------------------------------------------------------
54
55      !                     ! Allocate C14b arrays
56      IF( trc_sms_c14b_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' )
57
58      CALL trc_ctl_c14b     !  Control consitency
59
60      IF(lwp) WRITE(numout,*) ''
61      IF(lwp) WRITE(numout,*) ' trc_ini_c14b: initialisation of Bomb C14 chemical model'
62      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
63
64
65      ! Initialization of boundaries conditions
66      ! ---------------------------------------
67      qtr_c14(:,:) = 0._wp
68     
69      ! Initialization of qint in case of  no restart
70      !----------------------------------------------
71      IF( .NOT. ln_rsttr ) THEN   
72         IF(lwp) THEN
73            WRITE(numout,*)
74            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero '
75         ENDIF
76         trn     (:,:,:,jpc14) = 0._wp
77         qint_c14(:,:        ) = 0._wp
78      ENDIF
79
80
81      ! Read CO2 atmospheric concentrations file...
82      ! read CO2 data from year jpybeg to year jpyend
83      !------------------------------------------------
84
85      nrec    = ( jpyend - jpybeg + 1 )     ! number of year in CO2 Concentrations file
86      nmaxrec = 2 * nrec
87
88      IF(lwp) WRITE(numout,*) 'Read CO2 atmospheric concentrations file '
89 
90      CALL ctl_opn( inum1, 'splco2.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
91      REWIND(inum1)
92     
93      DO jm = 1, 5        ! Skip over 1st six descriptor lines
94         READ(inum1,'(1x)')
95      END DO
96
97      ! get  CO2 data
98      DO jm = 1, nmaxrec
99         READ(inum1, *)  zyear, spco2(jm)
100         IF (lwp) WRITE(numout, '(f7.1,f9.4)')  zyear, spco2(jm)
101      END DO
102      WRITE(numout,*)
103      CLOSE(inum1)
104
105      IF (lwp) WRITE(numout,*) 'Read C-14 atmospheric concentrations file '
106
107      CALL ctl_opn( inum2, 'atmc14.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
108      REWIND(inum2)
109
110      ! Skip over 1st descriptor line
111      READ(inum2, '(1x)')
112
113      ! READ FILE
114      DO jm = 1, nrec
115         READ(inum2,*) zyear, bomb(jm,1), bomb(jm,2), bomb(jm,3)
116         IF (lwp) WRITE(numout, '(f7.1, 3f9.4)') zyear, bomb(jm,1), bomb(jm,2), bomb(jm,3)
117      END DO
118      CLOSE(inum2)
119
120      ! Conversion unit : Now atm units are in real C-14 [per mil]
121      ! C-14(Orr) = C-14(per mil)/10.0
122       DO jm = 1, nrec
123         bomb(jm,1) = ( bomb(jm,1 ) + 17.40 ) * 0.1
124         bomb(jm,2) = ( bomb(jm,2 ) + 10.40 ) * 0.1
125         bomb(jm,3) = ( bomb(jm,3 ) + 14.65 ) * 0.1
126       END DO
127
128       ! Linear  interpolation of the C-14 source fonction
129       ! in linear latitude band  (20N,40N) and (20S,40S)
130       !------------------------------------------------------
131       DO jj = 1 , jpj
132          DO ji = 1 , jpi
133            IF( gphit(ji,jj) >= yn40 ) THEN
134                 fareaz(ji,jj,1) = 0.
135                 fareaz(ji,jj,2) = 0.
136                 fareaz(ji,jj,3) = 1.
137            ELSE IF( gphit(ji,jj ) <= ys40) THEN
138                 fareaz(ji,jj,1) = 1.
139                 fareaz(ji,jj,2) = 0.
140                 fareaz(ji,jj,3) = 0.
141            ELSE IF( gphit(ji,jj) >= yn20 ) THEN
142                 fareaz(ji,jj,1) = 0.
143                 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 )
144                 fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1.
145            ELSE IF( gphit(ji,jj) <= ys20 ) THEN
146                 fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1.
147                 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 )
148                 fareaz(ji,jj,3) = 0.
149            ELSE
150                 fareaz(ji,jj,1) = 0.
151                 fareaz(ji,jj,2) = 1.
152                 fareaz(ji,jj,3) = 0.
153            ENDIF
154         END DO
155      END DO
156      !
157      IF(lwp) WRITE(numout,*) 'Initialization of C14 bomb tracer done'
158      IF(lwp) WRITE(numout,*) ' '
159      !
160   END SUBROUTINE trc_ini_c14b
161
162
163   SUBROUTINE trc_ctl_c14b
164      !!----------------------------------------------------------------------
165      !!                     ***  ROUTINE trc_ctl_c14b  ***
166      !!
167      !! ** Purpose :   control the cpp options, namelist and files
168      !!----------------------------------------------------------------------
169
170      IF(lwp) THEN
171          WRITE(numout,*) ' C14 bomb Model '
172          WRITE(numout,*) ' '
173      ENDIF
174
175      ! Check number of tracers
176      ! -----------------------   
177      IF( jp_c14b > 1)   CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' )
178
179      ! Check tracer names
180      ! ------------------
181      IF( ctrcnm(jpc14) /= 'C14B' ) THEN
182          ctrcnm(jpc14)  = 'C14B'
183          ctrcln(jpc14)  = 'Bomb C14 concentration'
184      ENDIF
185
186      IF(lwp) THEN
187         CALL ctl_warn( ' we force tracer names' )
188         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcln(jpc14)
189         WRITE(numout,*) ' '
190      ENDIF
191
192      ! Check tracer units
193      ! ------------------
194      IF( ctrcun(jpc14) /= 'ration' ) THEN
195          ctrcun(jpc14)  = 'ration'
196          IF(lwp) THEN
197             CALL ctl_warn( ' we force tracer unit' )
198             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14)
199             WRITE(numout,*) ' '
200          ENDIF
201       ENDIF
202      !
203   END SUBROUTINE trc_ctl_c14b
204   
205#else
206   !!----------------------------------------------------------------------
207   !!   Dummy module                                    No C14 bomb tracer
208   !!----------------------------------------------------------------------
209CONTAINS
210   SUBROUTINE trc_ini_c14b             ! Empty routine
211   END SUBROUTINE trc_ini_c14b
212#endif
213
214   !!======================================================================
215END MODULE trcini_c14b
Note: See TracBrowser for help on using the repository browser.