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/NERC/dev_r5518_NOC_unchanged/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: branches/NERC/dev_r5518_NOC_unchanged/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90 @ 6240

Last change on this file since 6240 was 6240, checked in by jpalmier, 8 years ago

JPALM -- 13-01-2016 -- clean svn_key

File size: 5.9 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   !!----------------------------------------------------------------------
8#if defined key_cfc
9   !!----------------------------------------------------------------------
10   !!   'key_cfc'                                               CFC tracers
11   !!----------------------------------------------------------------------
12   !! trc_ini_cfc      : CFC model initialisation
13   !!----------------------------------------------------------------------
14   USE oce_trc         ! Ocean variables
15   USE par_trc         ! TOP parameters
16   USE trc             ! TOP variables
17   USE trcsms_cfc      ! CFC sms trends
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
23
24   CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ???
25
26   INTEGER  ::   inum                   ! unit number
27   REAL(wp) ::   ylats = -10.           ! 10 degrees south
28   REAL(wp) ::   ylatn =  10.           ! 10 degrees north
29
30   !!----------------------------------------------------------------------
31   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
32   !! $Id$
33   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35CONTAINS
36
37   SUBROUTINE trc_ini_cfc
38      !!----------------------------------------------------------------------
39      !!                     ***  trc_ini_cfc  *** 
40      !!
41      !! ** Purpose :   initialization for cfc model
42      !!
43      !! ** Method  : - Read the namcfc namelist and check the parameter values
44      !!----------------------------------------------------------------------
45      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr
46      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines
47      REAL(wp) ::  zyy, zyd
48      !!----------------------------------------------------------------------
49
50      IF(lwp) WRITE(numout,*)
51      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
52      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
53
54
55      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm'
56     
57      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
58      REWIND(inum)
59     
60      ! compute the number of year in the file
61      ! file starts in 1931 do jn represent the year in the century
62      jn = 31 
63      DO
64        READ(inum,'(1x)',END=100) 
65        jn = jn + 1
66      END DO
67 100  jpyear = jn - 1 - iskip
68      IF ( lwp) WRITE(numout,*) '    ', jpyear ,' years read'
69      !                                ! Allocate CFC arrays
70
71      ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr )
72      IF( ierr > 0 ) THEN
73         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN
74      ENDIF
75      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' )
76
77
78      ! Initialization of boundaries conditions
79      ! ---------------------------------------
80      xphem (:,:)    = 0._wp
81      p_cfc(:,:,:)   = 0._wp
82     
83      ! Initialization of qint in case of  no restart
84      !----------------------------------------------
85      qtr_cfc(:,:,:) = 0._wp
86      IF( .NOT. ln_rsttr ) THEN   
87         IF(lwp) THEN
88            WRITE(numout,*)
89            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero '
90         ENDIF
91         qint_cfc(:,:,:) = 0._wp
92         DO jl = 1, jp_cfc
93            jn = jp_cfc0 + jl - 1
94            trn(:,:,:,jn) = 0._wp
95         END DO
96      ENDIF
97
98      REWIND(inum)
99     
100      DO jm = 1, iskip        ! Skip over 1st six descriptor lines
101         READ(inum,'(1x)')
102      END DO
103      ! file starts in 1931 do jn represent the year in the century.jhh
104      ! Read file till the end
105      jn = 31
106      DO
107        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2)
108        IF( io < 0 ) exit
109        jn = jn + 1
110      END DO
111
112      p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
113      p_cfc(33,1:2,1) = 8.e-4
114      p_cfc(34,1:2,1) = 1.e-6
115      p_cfc(35,1:2,1) = 2.e-3
116      p_cfc(36,1:2,1) = 4.e-3
117      p_cfc(37,1:2,1) = 6.e-3
118      p_cfc(38,1:2,1) = 8.e-3
119      p_cfc(39,1:2,1) = 1.e-2
120     
121      IF(lwp) THEN        ! Control print
122         WRITE(numout,*)
123         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS '
124         DO jn = 30, jpyear
125            WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2)
126         END DO
127      ENDIF
128
129
130      ! Interpolation factor of atmospheric partial pressure
131      ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
132      !---------------------------------------------------------------------------------------
133      zyd = ylatn - ylats     
134      DO jj = 1 , jpj
135         DO ji = 1 , jpi
136            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
137            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
138            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
139            ENDIF
140         END DO
141      END DO
142      !
143      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
144      IF(lwp) WRITE(numout,*) ' '
145      !
146   END SUBROUTINE trc_ini_cfc
147   
148#else
149   !!----------------------------------------------------------------------
150   !!   Dummy module                                         No CFC tracers
151   !!----------------------------------------------------------------------
152CONTAINS
153   SUBROUTINE trc_ini_cfc             ! Empty routine
154   END SUBROUTINE trc_ini_cfc
155#endif
156
157   !!======================================================================
158END MODULE trcini_cfc
Note: See TracBrowser for help on using the repository browser.