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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90 @ 2690

Last change on this file since 2690 was 2690, checked in by gm, 13 years ago

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

  • Property svn:keywords set to Id
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) from trcini.cfc.h90
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
46      REAL(wp) ::  zyy, zyd
47      !!----------------------------------------------------------------------
48
49      IF(lwp) WRITE(numout,*)
50      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
51      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
52
53      !                                ! Allocate CFC arrays
54      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' )
55
56
57      ! Initialization of boundaries conditions
58      ! ---------------------------------------
59      xphem (:,:)    = 0._wp
60      p_cfc(:,:,:)   = 0._wp
61     
62      ! Initialization of qint in case of  no restart
63      !----------------------------------------------
64      qtr_cfc(:,:,:) = 0._wp
65      IF( .NOT. ln_rsttr ) THEN   
66         IF(lwp) THEN
67            WRITE(numout,*)
68            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero '
69         ENDIF
70         qint_cfc(:,:,:) = 0._wp
71         DO jl = 1, jp_cfc
72            jn = jp_cfc0 + jl - 1
73            trn(:,:,:,jn) = 0._wp
74         END DO
75      ENDIF
76
77
78      !   READ CFC partial pressure atmospheric value :
79      !     p11(year,nt) = PCFC11  in northern (1) and southern (2) hemisphere
80      !     p12(year,nt) = PCFC12  in northern (1) and southern (2) hemisphere
81      !--------------------------------------------------------------------
82
83      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm'
84     
85      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
86      REWIND(inum)
87     
88      DO jm = 1, 6        ! Skip over 1st six descriptor lines
89         READ(inum,'(1x)')
90      END DO
91   
92      ! file starts in 1931 do jn represent the year in the century.jhh
93      ! Read file till the end
94      jn = 31
95      DO WHILE ( 1 /= 2 )
96         READ(inum,*,END=100) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2)
97         IF ( lwp) THEN
98           WRITE(numout,'(f7.2, 4f8.2)' ) &
99            &         zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2)
100         ENDIF
101         jn = jn + 1
102      END DO
103 100  npyear = jn - 1
104      IF ( lwp) WRITE(numout,*) '    ', npyear ,' years read'
105
106      p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
107      p_cfc(33,1:2,1) = 8.e-4
108      p_cfc(34,1:2,1) = 1.e-6
109      p_cfc(35,1:2,1) = 2.e-3
110      p_cfc(36,1:2,1) = 4.e-3
111      p_cfc(37,1:2,1) = 6.e-3
112      p_cfc(38,1:2,1) = 8.e-3
113      p_cfc(39,1:2,1) = 1.e-2
114     
115      IF(lwp) THEN        ! Control print
116         WRITE(numout,*)
117         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS '
118         DO jn = 30, 100
119            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)
120         END DO
121      ENDIF
122
123
124      ! Interpolation factor of atmospheric partial pressure
125      ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
126      !---------------------------------------------------------------------------------------
127      zyd = ylatn - ylats     
128      DO jj = 1 , jpj
129         DO ji = 1 , jpi
130            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
131            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
132            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
133            ENDIF
134         END DO
135      END DO
136      !
137      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
138      IF(lwp) WRITE(numout,*) ' '
139      !
140   END SUBROUTINE trc_ini_cfc
141   
142#else
143   !!----------------------------------------------------------------------
144   !!   Dummy module                                         No CFC tracers
145   !!----------------------------------------------------------------------
146CONTAINS
147   SUBROUTINE trc_ini_cfc             ! Empty routine
148   END SUBROUTINE trc_ini_cfc
149#endif
150
151   !!======================================================================
152END MODULE trcini_cfc
Note: See TracBrowser for help on using the repository browser.