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.
dtasst.F90 in trunk/NEMO/OPA_SRC/DTA – NEMO

source: trunk/NEMO/OPA_SRC/DTA/dtasst.F90 @ 392

Last change on this file since 392 was 392, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

  • add agrif to dynspg_flt_jki.F90
  • cosmetic change of key_AGRIF in key_agrif
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.7 KB
Line 
1MODULE dtasst
2   !!======================================================================
3   !!                       ***  MODULE  dtasst  ***
4   !! Data : Sea Surface Temperature (SST)
5   
6   !!      BUG initialisation  nyearsst !!!!!!bug
7   
8   !!======================================================================
9   
10   !!----------------------------------------------------------------------
11   !!   dta_sst      : Reynolds sst data
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
16   USE in_out_manager  ! I/O manager
17   USE ocfzpt          ! ???
18   USE daymod          ! calendar
19
20   IMPLICIT NONE
21   PRIVATE
22
23   !! * Shared routine
24   PUBLIC dta_sst
25
26   !! * Shared module variables
27#if defined key_dtasst
28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   !: sst data flag
29#else
30   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .FALSE.  !: sst data flag
31#endif
32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
33      sst             !: surface temperature
34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) ::   &  !:
35      rclice          !: climatological ice index (0/1) (2 months)
36   !!----------------------------------------------------------------------
37   !!   OPA 9.0 , LOCEAN-IPSL (2005)
38   !! $Header$
39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44#if defined key_dtasst
45   !!----------------------------------------------------------------------
46   !!   'key_dtasst'                                               SST data
47   !!----------------------------------------------------------------------
48
49   SUBROUTINE dta_sst( kt )
50      !!---------------------------------------------------------------------
51      !!                  ***  ROUTINE dta_sst  ***
52      !!                   
53      !! ** Purpose :   Read Reynolds weekly mean sea surface temperature
54      !!      data and update it at each time step.
55      !!
56      !! ** Method  : - Read a specific REYNOLDS daily sst in Celcius.
57      !!              -  Compute a climatological ice cover rclice (0 or 1)
58      !!
59      !! ** Action  : - sst (Celcius)
60      !!              - rclice, ice/ocean mask (0 or 1)
61      !!
62      !! History :
63      !!        !  90-03  (O. Marti and Ph Dandin)  Original code
64      !!        !  92-07  (M. Imbard)
65      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
66      !!        !  00-04  (M. Imbard)  NetCDF FORMAT
67      !!        !  00-10  (J.-P. Boulanger)  passage ORCA a TDH
68      !!        !  01-10  (A. Lazar)  Reynolds default
69      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
70      !!        !  02-11  (C. Levy)  MPP/MPI NetCDF read
71      !!----------------------------------------------------------------------
72      !! * Modules used
73      USE ioipsl
74     
75      !! * Arguments
76      INTEGER ::   kt
77
78      !! * Local save
79      INTEGER, SAVE ::   &
80      ndaysst,        &  ! new day for Reynolds sst
81      nyearsst           ! new year for Reynolds sst
82
83      !! * Local declarations
84      INTEGER ::   ji, jj
85      INTEGER ::   iprint
86      INTEGER ::   iy, iday, idy
87      INTEGER ::   istep(366)
88      INTEGER ::   ipi, ipj, ipk
89
90      REAL(wp) ::   zdate0, zdt, ztgel
91      REAL(wp) ::   zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk)
92      CHARACTER (len=45) ::   &
93         clname       ! filename for daily SST
94      !!----------------------------------------------------------------------
95         clname = 'sst_1d.nc'
96#if defined key_agrif
97      if ( .NOT. Agrif_Root() ) then
98         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
99      endif
100#endif         
101      IF( kt == nit000 ) THEN
102         IF(lwp) WRITE(numout,*)
103         IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data'
104         IF(lwp) WRITE(numout,*) '~~~~~~~   read in file: ', clname
105         sst(:,:) = 0.e0   ! required for extra halos in mpp
106      ENDIF
107
108
109      ! 0. initialization
110      ! -----------------
111
112      ipi = jpiglo
113      ipj = jpjglo
114      ipk = jpk
115
116      IF( nleapy == 0 ) THEN
117         idy=365
118      ELSEIF( nleapy == 1 ) THEN
119         IF( MOD( nyear, 4 ) == 0 ) THEN
120            idy=366
121         ELSE
122            idy=365
123         ENDIF
124      ELSEIF( nleapy == 30 ) THEN
125         IF(lwp) WRITE(numout,*) 'dtasst : nleapy = 30 is not compatible'
126         IF(lwp) WRITE(numout,*) '         with existing files'
127         IF(lwp) WRITE(numout,*) 'WE STOP'
128         STOP 1234
129      ENDIF
130     
131     
132      ! 2. Open files if nyearsst
133      ! -------------------------
134
135      IF( nyearsst /= nyear ) THEN
136         nyearsst = nyear
137         iprint   = 1
138         
139         !  2.1 Define file name and record
140         
141         !   Close/open file if new year
142         
143         IF( nyearsst /= 0 )   CALL flinclo(numsst)
144         iy = nyear
145         IF(lwp) WRITE (numout,*) iy
146         IF(lwp) WRITE (numout,*) 'open sst file = ', clname
147         CALL FLUSH(numout)
148         
149         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj   &
150            , ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsst )
151         
152         IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN
153            IF(lwp) WRITE(numout,*)
154            IF(lwp) WRITE(numout,*) 'problem with dimensions'
155            IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta
156            IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta
157            nstop = nstop + 1
158         ENDIF
159         IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt
160      ELSE
161         iprint = 0
162      ENDIF
163
164
165      ! 3. Read SST if new day
166      ! -------------------------
167
168      ! Read daily SST
169
170      IF( ndaysst /= nday ) THEN
171         ndaysst = nday
172         iday = nday_year
173         
174         CALL flinget( numsst, 'sst', jpidta, jpjdta, 1, idy, iday,   &
175            iday, mig(1), nlci, mjg(1), nlcj, sst(1:nlci,1:nlcj) )
176         
177         IF ( kt == nit000 .AND. lwp ) THEN
178            WRITE(numout,*) ' '
179            WRITE(numout,*) ' read daily sea surface temperature ok'
180            WRITE(numout,*) ' '
181            WRITE(numout,*) ' Surface temp day: ', ndastp
182            CALL prihre(sst(1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout)
183         ENDIF
184         
185      ENDIF
186     
187      ! 2. At every time step compute temperature data
188      ! ----------------------------------------------
189     
190      DO jj = 1, jpj
191         DO ji = 1, jpi
192            ztgel = fzptn(ji,jj)
193            rclice(ji,jj,1) = tmask(ji,jj,1)
194            IF( sst(ji,jj) >= ztgel )   rclice(ji,jj,1) = 0.e0
195            rclice(ji,jj,2) = rclice(ji,jj,1)
196         END DO
197      END DO
198      IF( kt == nit000 .AND. lwp ) THEN
199         WRITE(numout,*)
200         WRITE(numout,*) 'Computed Ice cover rclice'
201         WRITE(numout,*)
202         WRITE(numout,*) 'Ice cover : '
203         CALL prihre( rclice(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
204      ENDIF
205     
206      ! Close the file
207      ! --------------
208     
209      IF( kt == nitend )   CALL flinclo(numsst)
210      CALL FLUSH(numout)
211     
212
213   END SUBROUTINE dta_sst
214
215#else
216   !!----------------------------------------------------------------------
217   !!   Default option :                                        NO SST data
218   !!----------------------------------------------------------------------
219
220   SUBROUTINE dta_sst( kt )
221      !!---------------------------------------------------------------------
222      !!                  ***  ROUTINE dta_sst  ***
223      !!                   
224      !! ** Purpose :   sea surface temperature data and update it
225      !!     at each time step.   ???
226      !!
227      !! ** Method  : - sst   = tn
228      !!              - rclice = 1. IF tn =< ztgel
229      !!
230      !! History :
231      !!        !  91-03  ()  Original code
232      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
233      !!----------------------------------------------------------------------
234      !! * Arguments
235      INTEGER, INTENT( in ) ::   kt      ! ocean timestep
236     
237      !! * Local declarations
238      INTEGER :: ji, jj
239      !!---------------------------------------------------------------------
240     
241      IF( kt == nit000 ) THEN
242         IF(lwp) WRITE(numout,*)
243         IF(lwp) WRITE(numout,*) 'dta_sst : No SST data'
244         IF(lwp) WRITE(numout,*) '~~~~~~~'
245      ENDIF
246     
247      ! 1. Update at each time step
248      ! ---------------------------
249
250      sst   (:,:)   = tn   (:,:,1)
251      rclice(:,:,1) = tmask(:,:,1)
252      DO jj = 1, jpj
253         DO ji = 1, jpi
254            IF( tn(ji,jj,1) >= fzptn(ji,jj) ) rclice(ji,jj,1) = 0.e0
255         END DO
256      END DO
257      rclice(:,:,2) = rclice(:,:,1)
258     
259   END SUBROUTINE dta_sst
260#endif
261
262   !!======================================================================
263END MODULE dtasst
Note: See TracBrowser for help on using the repository browser.