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_cfc.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 7.5 KB
Line 
1MODULE trcini_cfc
2   !!======================================================================
3   !!                         ***  MODULE trcini_cfc  ***
4   !! TOP :   initialisation of the CFC tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)
7   !!                  !  2017-04  (A. Yool)  Add SF6
8   !!----------------------------------------------------------------------
9#if defined key_cfc
10   !!----------------------------------------------------------------------
11   !!   'key_cfc'                                               CFC tracers
12   !!----------------------------------------------------------------------
13   !! trc_ini_cfc      : CFC model initialisation
14   !!----------------------------------------------------------------------
15   USE oce_trc         ! Ocean variables
16   USE par_trc         ! TOP parameters
17   USE trc             ! TOP variables
18   USE trcsms_cfc      ! CFC sms trends
19
20   USE yomhook, ONLY: lhook, dr_hook
21   USE parkind1, ONLY: jprb, jpim
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
27
28   CHARACTER (len=34) ::   clname = 'cfc1112sf6.atm'   ! ???
29
30   INTEGER  ::   inum                   ! unit number
31   REAL(wp) ::   ylats = -10.           ! 10 degrees south
32   REAL(wp) ::   ylatn =  10.           ! 10 degrees north
33
34   !!----------------------------------------------------------------------
35   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
36   !! $Id$
37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE trc_ini_cfc
42      !!----------------------------------------------------------------------
43      !!                     ***  trc_ini_cfc  *** 
44      !!
45      !! ** Purpose :   initialization for cfc model
46      !!
47      !! ** Method  : - Read the namcfc namelist and check the parameter values
48      !!----------------------------------------------------------------------
49      INTEGER  ::  ji, jj, jn, jl, jm, js, io, iostatus, ierr
50      INTEGER  ::  iskip = 7   ! number of 1st descriptor lines
51      REAL(wp) ::  zyy, zyd
52      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
53      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
54      REAL(KIND=jprb)               :: zhook_handle
55
56      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_INI_CFC'
57
58      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
59
60      !!----------------------------------------------------------------------
61
62      IF(lwp) WRITE(numout,*)
63      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
64      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
65
66
67      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112sf6.atm'
68     
69      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
70     
71      ! compute the number of year in the file
72      ! file starts in 1931 do jn represent the year in the century
73      iostatus = 0
74      jn = 31 
75      DO WHILE ( iostatus == 0 )
76        READ(inum,'(1x)', IOSTAT=iostatus, END=100)
77        jn = jn + 1
78      ENDDO
79      IF( iostatus .NE. 0 ) THEN
80        !! Error while reading CFC input file
81        CALL ctl_stop('trc_ini_cfc:  &
82                      & Error on the 1st reading of cfc1112sf6.atm')
83      IF (lhook) CALL dr_hook(RoutineName,zhook_out ,zhook_handle)
84        RETURN
85      ENDIF
86 100  jpyear = jn - 1 - iskip
87      IF ( lwp) WRITE(numout,*) '    ', jpyear ,' years read'
88      !                                ! Allocate CFC arrays
89
90      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr )
91      IF( ierr > 0 ) THEN
92         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   
93      IF (lhook) CALL dr_hook(RoutineName,zhook_out ,zhook_handle)
94         RETURN
95      ENDIF
96      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' )
97
98
99      ! Initialization of boundaries conditions
100      ! ---------------------------------------
101      xphem (:,:)    = 0._wp
102      p_cfc(:,:,:)   = 0._wp
103     
104      ! Initialization of qint in case of  no restart
105      !----------------------------------------------
106      qtr_cfc(:,:,:) = 0._wp
107      IF( .NOT. ln_rsttr ) THEN   
108         IF(lwp) THEN
109            WRITE(numout,*)
110            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero '
111         ENDIF
112         qint_cfc(:,:,:) = 0._wp
113         trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
114      ENDIF
115
116      REWIND(inum)
117     
118      DO jm = 1, iskip        ! Skip over 1st six descriptor lines
119         READ(inum,'(1x)')
120      END DO
121      ! file starts in 1931 do jn represent the year in the century.jhh
122      ! Read file till the end
123      DO jn = 31, jpyear 
124        !!READ(inum, '(F6.1,6F7.2)', IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), &
125        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), &
126             & p_cfc(jn,1,3), p_cfc(jn,2,1),  &
127             & p_cfc(jn,2,2), p_cfc(jn,2,3)
128        IF( io .NE.0 )  THEN
129          !! Error while reading CFC input file
130          CALL ctl_stop('trc_ini_cfc:   &
131                        & Error on the 2nd reading of cfc1112sf6.atm')
132      IF (lhook) CALL dr_hook(RoutineName,zhook_out ,zhook_handle)
133          RETURN
134        ENDIF
135      END DO
136
137      ! AXY (25/04/17): do not adjust
138      ! p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
139      ! p_cfc(33,1:2,1) = 8.e-4
140      ! p_cfc(34,1:2,1) = 1.e-6
141      ! p_cfc(35,1:2,1) = 2.e-3
142      ! p_cfc(36,1:2,1) = 4.e-3
143      ! p_cfc(37,1:2,1) = 6.e-3
144      ! p_cfc(38,1:2,1) = 8.e-3
145      ! p_cfc(39,1:2,1) = 1.e-2
146     
147      IF(lwp) THEN        ! Control print
148         WRITE(numout,*)
149         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS    pSF6N    pSF6S '
150         DO jn = 30, jpyear
151            WRITE(numout, '( 1I4, 6F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), &
152                 & p_cfc(jn,1,2), p_cfc(jn,2,2), &
153                 & p_cfc(jn,1,3), p_cfc(jn,2,3)
154         END DO
155      ENDIF
156
157      ! Interpolation factor of atmospheric partial pressure
158      ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
159      !---------------------------------------------------------------------------------------
160      zyd = ylatn - ylats     
161      DO jj = 1 , jpj
162         DO ji = 1 , jpi
163            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
164            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
165            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
166            ENDIF
167         END DO
168      END DO
169      !
170      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
171      IF(lwp) WRITE(numout,*) ' '
172      !
173      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
174   END SUBROUTINE trc_ini_cfc
175   
176#else
177   !!----------------------------------------------------------------------
178   !!   Dummy module                                         No CFC tracers
179   !!----------------------------------------------------------------------
180CONTAINS
181   SUBROUTINE trc_ini_cfc             ! Empty routine
182   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
183   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
184   REAL(KIND=jprb)               :: zhook_handle
185
186   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_INI_CFC'
187
188   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
189
190   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
191   END SUBROUTINE trc_ini_cfc
192#endif
193
194   !!======================================================================
195END MODULE trcini_cfc
Note: See TracBrowser for help on using the repository browser.