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.
crs_iom.F90 in branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

source: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs_iom.F90 @ 3622

Last change on this file since 3622 was 3622, checked in by cetlod, 11 years ago

branch 2013/dev_r3411_CNRS4_IOCRS : 1st inputs of I/O coarsening, see ticket #1009
  • Property svn:executable set to *
File size: 12.0 KB
Line 
1MODULE crs_iom
2   !!=====================================================================
3   !!                    ***  MODULE  crs_iom ***
4   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
5   !!====================================================================
6   !! History :  9.0  ! 12 06  (J. Simeon) Original code
7   !!
8   !!
9   !!            kdompar_crs(1,1) = global x-dimension, jpiglo_crs
10   !!            kdompar_crs(2,1) = global y-dimension, jpjglo_crs
11   !!            kdompar_crs(:,2) 
12   !!  from dom_oce INTEGER nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom
13   !!
14   !!  From LBC/mppini.F90     
15   !!  ! No mpp computation
16   !!   nimpp  = 1
17   !!   njmpp  = 1
18   !!   nlci   = jpi
19   !!   nlcj   = jpj
20   !!   nldi   = 1
21   !!   nldj   = 1
22   !!   nlei   = jpi
23   !!   nlej   = jpj
24   !!   nperio = jperio
25   !!   nbondi = 2
26   !!   nbondj = 2
27   !!   nidom  = FLIO_DOM_NONE
28   !!   npolj = jperio
29   !!
30   !! jes. 28 Jun 2012. TODO. make sure of variable declarations to be placed here or crs_dom.F90
31   !!--------------------------------------------------------------------
32   USE timing
33   USE crs_dom
34   USE dom_oce         ! ocean space and time domain
35   USE iom_def         ! iom variables definitions
36   USE netcdf          ! NetCDF library
37   USE in_out_manager  ! I/O manager
38   USE lib_mpp         ! MPP library
39   USE iom             ! I/O library
40   USE par_kind, ONLY: wp   
41
42
43   IMPLICIT NONE
44   PRIVATE
45
46   PUBLIC crs_iom_open, crs_iom_close, crs_iom_rstput, crs_iom_put
47
48!   PUBLIC crs_iom_varid, crs_iom_get, crs_iom_gettime
49
50
51   INTEGER, PARAMETER ::   jpdomcrs_data          = 1   !: ( 1  :jpiglo_crs, 1  :jpjglo_crs)
52   INTEGER, PARAMETER ::   jpdomcrs_global        = 2   !: ( 1  :jpiglo_crs, 1  :jpjglo_crs)
53   INTEGER, PARAMETER ::   jpdomcrs_local         = 3   !: One of the 3 following cases
54   INTEGER, PARAMETER ::   jpdomcrs_local_full    = 4   !: ( 1  :jpi_crs   , 1  :jpj_crs   )
55   INTEGER, PARAMETER ::   jpdomcrs_local_noextra = 5   !: ( 1  :nlci_crs  , 1  :nlcj_crs  )
56   INTEGER, PARAMETER ::   jpdomcrs_local_noovlap = 6   !: (nldi_crs:nlei_crs  ,nldj_crs:nlej_crs  )
57   INTEGER, PARAMETER ::   jpdomcrs_unknown       = 7   !: No dimension checking
58   INTEGER, PARAMETER ::   jpdomcrs_autoglo       = 8   !:
59   INTEGER, PARAMETER ::   jpdomcrs_autodta       = 9   !:
60   INTEGER            ::   ipdomcrs_local_noovlap_crs, ipdomcrs_local_full_crs, idomcrs_local_noextra_crs
61
62   INTEGER                 ::   idomcrs     ! Type of domain to be written (default = jpdom_local_noovlap)
63   INTEGER, DIMENSION(2,5) ::   idompar_crs ! domain parameters:   
64   LOGICAL                 ::   llnoov      ! local definition to read overlap
65
66
67CONTAINS
68
69   SUBROUTINE crs_iom_open( cdname, kiomid, ldwrt, kdom, kiolib )
70      !!--------------------------------------------------------------------
71      !!                       ***  MODULE crs_iom_open  ***
72      !!
73      !! ** Purpose : open an input file with NF90 on coarsened grid
74      !!---------------------------------------------------------------------
75      !! Arguments
76      CHARACTER(len=*)       , INTENT(in)           ::   cdname   ! File name
77      INTEGER                , INTENT(inout)        ::   kiomid   ! nf90 identifier of the opened file
78      LOGICAL                , INTENT(in)           ::   ldwrt    ! read or write the file?
79      INTEGER                , INTENT(in), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
80      INTEGER                , INTENT(in), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90)
81
82
83      !! Save the parent grid information
84      jpi_full    = jpi 
85      jpj_full    = jpj
86      jpim1_full  = jpim1
87      jpjm1_full  = jpjm1
88      nperio_full = nperio
89
90      npolj_full  = npolj 
91      jpnij_full  = jpnij
92      narea_full  = narea
93      npiglo_full = jpiglo 
94      npjglo_full = jpjglo
95
96      nlcj_full   = nlcj 
97      nlci_full   = nlci
98      nldi_full   = nldi
99      nlei_full   = nlei
100      nlej_full   = nlej
101      nldj_full   = nldj
102
103      !! Switch to coarse grid domain
104      jpi    = jpi_crs 
105      jpj    = jpj_crs
106      jpim1  = jpi_crsm1
107      jpjm1  = jpj_crsm1
108      nperio = nperio_crs
109
110      npolj  = npolj_crs 
111      jpnij  = jpnij_crs
112      narea  = narea_crs
113      npiglo = jpiglo_crs 
114      npjglo = jpjglo_crs 
115
116      nlci   = nlci_crs
117      nlcj   = nlcj_crs
118      nldi   = nldi_crs
119      nlei   = nlei_crs
120      nlej   = nlej_crs
121
122      nldj   = nldj_crs
123
124
125      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
126      IF( llnoov ) THEN   ;   idomcrs = jpdomcrs_local_noovlap   ! default definition
127      ELSE                ;   idomcrs = jpdomcrs_local_full      ! default definition
128      ENDIF
129      IF ( PRESENT(kdom) ) idomcrs = kdom
130
131      WRITE(numout,*) 'crs_iom_open. kiomid=', kiomid
132
133      CALL iom_open( cdname, kiomid, ldwrt, idomcrs, kiolib )
134
135      WRITE(numout,*) 'crs_iom_open. after iom_open call kiomid=', kiomid
136
137      !! Return to parent grid domain
138      jpi    = jpi_full 
139      jpj    = jpj_full
140      jpim1  = jpim1_full
141      jpjm1  = jpjm1_full
142      nperio = nperio_full
143
144      npolj  = npolj_full 
145      jpnij  = jpnij_full
146      narea  = narea_full
147      npiglo = npiglo_full 
148      npjglo = npjglo_full 
149
150      nlcj   = nlcj_full 
151      nlci   = nlci_full
152      nldi   = nldi_full
153      nlei   = nlei_full
154      nlej   = nlej_full
155
156      nldj   = nldj_full
157
158   END SUBROUTINE crs_iom_open
159
160
161   SUBROUTINE crs_iom_close( kiomid )
162      !!--------------------------------------------------------------------
163      !!                       ***  MODULE crs_iom_open  ***
164      !!
165      !! ** Purpose : open an input file with NF90 on coarsened grid
166      !!---------------------------------------------------------------------
167      !! Arguments
168      INTEGER                , INTENT(inout)           ::   kiomid      ! nf90 identifier of the opened file
169      !! Local variable
170      CHARACTER(LEN=100)  ::   clinfo   ! info character
171      !---------------------------------------------------------------------
172      !
173      WRITE(numout,*) 'crs_iom_close. kiomid=', kiomid
174
175      CALL iom_close( kiomid )
176      WRITE(numout,*) 'crs_iom_close. after iom_open call kiomid=', kiomid
177
178      !   
179   END SUBROUTINE crs_iom_close
180
181
182   SUBROUTINE crs_iom_rstput( kt, kwrite, kiomid, cdvar, pv_r0d, pv_r1d, pv_r2d, pv_r3d, ktype )
183      !!--------------------------------------------------------------------
184      !!                   ***  SUBROUTINE  crs_iom_rp0d  ***
185      !!
186      !! ** Purpose : read the time axis cdvar in the file
187      !!--------------------------------------------------------------------
188      ! Arguments
189      INTEGER          ,                                  INTENT(in) :: kt       ! ocean time-step
190      INTEGER          ,                                  INTENT(in) :: kwrite   ! writing time-step
191      INTEGER          ,                                  INTENT(in) :: kiomid   ! Identifier of the file
192      CHARACTER(len=*) ,                                  INTENT(in) :: cdvar    ! variable name
193      REAL(wp), OPTIONAL,                                 INTENT(in) :: pv_r0d   ! written Od field
194      REAL(wp), OPTIONAL, DIMENSION(jpk),                 INTENT(in) :: pv_r1d   ! written 1d field
195      REAL(wp), OPTIONAL, DIMENSION(jpi_crs,jpj_crs) ,    INTENT(in) :: pv_r2d   ! written 2d field
196      REAL(wp), OPTIONAL, DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: pv_r3d   ! written 3d field
197      INTEGER,  OPTIONAL,                                 INTENT(in) :: ktype    ! variable type (default R8)
198
199      ! Local
200      INTEGER               :: ivid     ! variable id
201      INTEGER               :: itype    ! variable type
202
203      !! Save the parent grid information
204      jpi_full    = jpi 
205      jpj_full    = jpj
206      jpim1_full  = jpim1
207      jpjm1_full  = jpjm1
208      nperio_full = nperio
209
210      npolj_full  = npolj 
211      jpnij_full  = jpnij
212      narea_full  = narea
213      npiglo_full = jpiglo 
214      npjglo_full = jpjglo
215
216      nlcj_full   = nlcj 
217      nlci_full   = nlci
218      nldi_full   = nldi
219      nlei_full   = nlei
220      nlej_full   = nlej
221      nldj_full   = nldj
222
223      !! Switch to coarse grid domain
224      jpi    = jpi_crs 
225      jpj    = jpj_crs
226      jpim1  = jpi_crsm1
227      jpjm1  = jpj_crsm1
228      nperio = nperio_crs
229
230      npolj  = npolj_crs 
231      jpnij  = jpnij_crs
232      narea  = narea_crs
233      npiglo = jpiglo_crs 
234      npjglo = jpjglo_crs
235 
236      nlcj   = nlcj_crs 
237      nlci   = nlci_crs
238      nldi   = nldi_crs
239      nlei   = nlei_crs
240      nlej   = nlej_crs
241      nldj   = nldj_crs
242
243
244      IF(     PRESENT(pv_r0d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r0d, ktype )
245      ELSEIF( PRESENT(pv_r1d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r1d, ktype )
246      ELSEIF( PRESENT(pv_r2d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r2d, ktype )
247      ELSEIF( PRESENT(pv_r3d) ) THEN ; CALL iom_rstput( kt, kwrite, kiomid, cdvar, pv_r3d, ktype )
248      ENDIF
249
250      !! Return to parent grid domain
251      jpi    = jpi_full 
252      jpj    = jpj_full
253      jpim1  = jpim1_full
254      jpjm1  = jpjm1_full
255      nperio = nperio_full
256
257      npolj  = npolj_full 
258      jpnij  = jpnij_full
259      narea  = narea_full
260      npiglo = npiglo_full 
261      npjglo = npjglo_full
262 
263      nlcj   = nlcj_full 
264      nlci   = nlci_full
265      nldi   = nldi_full
266      nlei   = nlei_full
267      nlej   = nlej_full
268      nldj   = nldj_full
269
270 
271   END SUBROUTINE crs_iom_rstput
272
273   SUBROUTINE crs_iom_put( cdvar , pv_r0d, pv_r1d, pv_r2d, pv_r3d )
274      !!--------------------------------------------------------------------
275      !!                   ***  SUBROUTINE  iom_put  ***
276      !!
277      !! ** Purpose : read the time axis cdvar in the file
278      !!--------------------------------------------------------------------
279      ! Arguments
280      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
281      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
282      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
283      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
284      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
285
286      ! Local
287      INTEGER               :: ivid     ! variable id
288      INTEGER               :: itype    ! variable type
289
290      !! Save the parent grid information
291      jpi_full    = jpi 
292      jpj_full    = jpj
293      jpim1_full  = jpim1
294      jpjm1_full  = jpjm1
295      nperio_full = nperio
296
297      npolj_full  = npolj 
298      jpnij_full  = jpnij
299      narea_full  = narea
300      npiglo_full = jpiglo 
301      npjglo_full = jpjglo
302
303      nlcj_full   = nlcj 
304      nlci_full   = nlci
305      nldi_full   = nldi
306      nlei_full   = nlei
307      nlej_full   = nlej
308      nldj_full   = nldj
309
310      !! Switch to coarse grid domain
311      jpi    = jpi_crs 
312      jpj    = jpj_crs
313      jpim1  = jpi_crsm1
314      jpjm1  = jpj_crsm1
315      nperio = nperio_crs
316
317      npolj  = npolj_crs 
318      jpnij  = jpnij_crs
319      narea  = narea_crs
320      npiglo = jpiglo_crs 
321      npjglo = jpjglo_crs
322 
323      nlcj   = nlcj_crs 
324      nlci   = nlci_crs
325      nldi   = nldi_crs
326      nlei   = nlei_crs
327      nlej   = nlej_crs
328      nldj   = nldj_crs
329
330      ! variable definition
331      IF(     PRESENT(pv_r0d) ) THEN   ;  CALL iom_put( cdvar, pv_r0d )
332      ELSEIF( PRESENT(pv_r1d) ) THEN   ;  CALL iom_put( cdvar, pv_r1d )
333      ELSEIF( PRESENT(pv_r2d) ) THEN   ;  CALL iom_put( cdvar, pv_r2d )
334      ELSEIF( PRESENT(pv_r3d) ) THEN   ;  CALL iom_put( cdvar, pv_r3d )
335      ENDIF
336
337      !! Return to parent grid domain
338      jpi    = jpi_full 
339      jpj    = jpj_full
340      jpim1  = jpim1_full
341      jpjm1  = jpjm1_full
342      nperio = nperio_full
343
344      npolj  = npolj_full 
345      jpnij  = jpnij_full
346      narea  = narea_full
347      npiglo = npiglo_full 
348      npjglo = npjglo_full
349 
350      nlcj   = nlcj_full 
351      nlci   = nlci_full
352      nldi   = nldi_full
353      nlei   = nlei_full
354      nlej   = nlej_full
355      nldj   = nldj_full
356
357   END SUBROUTINE crs_iom_put
358
359!#if defined key_iomput
360
361!#endif
362
363END MODULE crs_iom
Note: See TracBrowser for help on using the repository browser.