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/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90 @ 7124

Last change on this file since 7124 was 7124, checked in by lovato, 8 years ago

New top interface : revise initialisation routines and namelist_top_cfg in ORCA2_LIM3_TRC, see ticket #1782

  • Property svn:keywords set to Id
File size: 5.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   !!----------------------------------------------------------------------
8   !!----------------------------------------------------------------------
9   !! trc_ini_cfc      : CFC model initialisation
10   !!----------------------------------------------------------------------
11   USE oce_trc         ! Ocean variables
12   USE par_trc         ! TOP parameters
13   USE trc             ! TOP variables
14   USE trcnam_cfc      ! CFC SMS namelist
15   USE trcsms_cfc      ! CFC sms trends
16
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
21
22   CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ???
23
24   INTEGER  ::   inum                   ! unit number
25   REAL(wp) ::   ylats = -10.           ! 10 degrees south
26   REAL(wp) ::   ylatn =  10.           ! 10 degrees north
27
28   !!----------------------------------------------------------------------
29   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
30   !! $Id$
31   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE trc_ini_cfc
36      !!----------------------------------------------------------------------
37      !!                     ***  trc_ini_cfc  *** 
38      !!
39      !! ** Purpose :   initialization for cfc model
40      !!
41      !! ** Method  : - Read the namcfc namelist and check the parameter values
42      !!----------------------------------------------------------------------
43      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr
44      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines
45      REAL(wp) ::  zyy, zyd
46      CHARACTER(len = 20)  ::  cltra
47      !!----------------------------------------------------------------------
48      !
49      CALL trc_nam_cfc
50      !
51      IF(lwp) WRITE(numout,*)
52      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
53      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
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      IF(lwp) THEN        ! Control print
121         WRITE(numout,*)
122         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS '
123         DO jn = 30, jpyear
124            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)
125         END DO
126      ENDIF
127
128
129      ! Interpolation factor of atmospheric partial pressure
130      ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
131      !---------------------------------------------------------------------------------------
132      zyd = ylatn - ylats     
133      DO jj = 1 , jpj
134         DO ji = 1 , jpi
135            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
136            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
137            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
138            ENDIF
139         END DO
140      END DO
141      !
142      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
143      IF(lwp) WRITE(numout,*) ' '
144      !
145   END SUBROUTINE trc_ini_cfc
146   
147   !!======================================================================
148END MODULE trcini_cfc
Note: See TracBrowser for help on using the repository browser.