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.
iom_dom.f90 in utils/tools/SIREN/src – NEMO

source: utils/tools/SIREN/src/iom_dom.f90

Last change on this file was 13369, checked in by jpaul, 4 years ago

update: cf changelog inside documentation

File size: 25.6 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! DESCRIPTION:
6!> @brief This module allow to read domain (defined as domain structure) in a mpp files.
7!>
8!> @details
9!>    to read one variable in an mpp files over domain defined as domain structure:<br/>
10!> @code
11!>    tl_var=iom_dom_read_var( td_mpp, id_varid, td_dom )
12!> @endcode
13!>    or
14!> @code
15!>    tl_var=iom_dom_read_var( td_mpp, cd_name, td_dom )
16!> @endcode
17!>       - td_mpp is a mpp structure
18!>       - id_varid is a variable id
19!>       - cd_name is variable name or standard name
20!>       - td_dom is a domain structure
21!>
22!> @author
23!> J.Paul
24!>
25!> @date October, 2014 - Initial Version
26!>
27!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
28!----------------------------------------------------------------------
29MODULE iom_dom
30
31   USE netcdf                          ! nf90 library
32   USE global                          ! global parameter
33   USE kind                            ! F90 kind parameter
34   USE fct                             ! basic useful function
35   USE logger                          ! log file manager
36   USE dim                             ! dimension manager
37   USE att                             ! attribute manager
38   USE var                             ! variable manager
39   USE iom                             ! I/O manager
40   USE mpp                             ! mpp manager
41   USe dom                             ! domain manager
42   USE iom_mpp                         ! I/O mpp manager
43
44   IMPLICIT NONE
45   ! NOTE_avoid_public_variables_if_possible
46
47   ! function and subroutine
48   PUBLIC :: iom_dom_open                    !< open files composing mpp structure over domain to be used
49   PUBLIC :: iom_dom_read_var                !< read one variable in an mpp structure over domain to be used
50   PUBLIC :: iom_dom_close                   !< close file composing mpp structure over domain
51
52   PRIVATE :: iom_dom__read_var_id           ! read one variable in an mpp structure, given variable id
53   PRIVATE :: iom_dom__read_var_name         ! read one variable in an mpp structure, given variable name
54   PRIVATE :: iom_dom__read_var_value        ! read variable value in an mpp structure
55   PRIVATE :: iom_dom__no_pole_no_overlap    ! do not overlap north fold boundary or east-west boundary
56   PRIVATE :: iom_dom__no_pole_cyclic        ! do not overlap north fold boundary. However uses cyclic east-west boundary
57   PRIVATE :: iom_dom__no_pole_overlap       ! do not overlap north fold boundary. However overlaps east-west boundary
58!   PRIVATE :: iom_dom__pole_no_overlap       ! overlaps north fold boundary. However do not overlap east-west boundary
59!   PRIVATE :: iom_dom__pole_cyclic           ! overlaps north fold boundary and uses cyclic east-west boundary
60!   PRIVATE :: iom_dom__pole_overlap          ! overlaps north fold boundary and east-west boundary
61
62   INTERFACE iom_dom_read_var                   ! read one variable in an mpp structure
63      MODULE PROCEDURE iom_dom__read_var_id     ! given variable id
64      MODULE PROCEDURE iom_dom__read_var_name   ! given variable name
65   END INTERFACE iom_dom_read_var
66
67CONTAINS
68   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
69   SUBROUTINE iom_dom_open(td_mpp, td_dom, id_perio, id_ew)
70   !-------------------------------------------------------------------
71   !> @brief This subroutine open files composing mpp structure
72   !> over domain to be used.
73   !>
74   !> @author J.Paul
75   !> @date October, 2014 - Initial Version
76   !
77   !> @param[inout] td_mpp mpp structure
78   !-------------------------------------------------------------------
79
80      IMPLICIT NONE
81
82      ! Argument
83      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
84      TYPE(TDOM) , INTENT(IN)    :: td_dom
85      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
86      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
87
88      ! local variable
89      ! loop indices
90      !----------------------------------------------------------------
91      ! check if mpp exist
92      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
93
94         CALL logger_error( " IOM DOM OPEN: domain decomposition not define "//&
95         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
96
97      ELSE
98         ! get processor to be used
99         CALL mpp_get_use( td_mpp, td_dom%i_imin, td_dom%i_imax, &
100         &                         td_dom%i_jmin, td_dom%i_jmax )
101
102         CALL iom_mpp_open(td_mpp, id_perio, id_ew)
103
104      ENDIF
105
106   END SUBROUTINE iom_dom_open
107   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
108   SUBROUTINE iom_dom_close(td_mpp)
109   !-------------------------------------------------------------------
110   !> @brief This subroutine close files composing mpp structure.
111   !>
112   !> @author J.Paul
113   !> @date October, 2014 - Initial Version
114   !
115   !> @param[in] td_mpp mpp structure
116   !-------------------------------------------------------------------
117
118      IMPLICIT NONE
119
120      ! Argument
121      TYPE(TMPP), INTENT(INOUT) :: td_mpp
122
123      ! loop indices
124      !----------------------------------------------------------------
125
126      CALL iom_mpp_close(td_mpp)
127
128   END SUBROUTINE iom_dom_close
129   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
130   FUNCTION iom_dom__read_var_id(td_mpp, id_varid, td_dom) &
131         & RESULT (tf_var)
132   !-------------------------------------------------------------------
133   !> @brief This function read variable value in opened mpp files,
134   !> given variable id and domain strcuture.
135   !>
136   !> @details
137   !> Optionally start indices and number of point to be read could be specify.
138   !> as well as East West ovelap of the global domain.
139   !>
140   !> @author J.Paul
141   !> @date October, 2014 - Initial Version
142   !>
143   !> @param[in] td_mpp    mpp structure
144   !> @param[in] id_varid  variable id
145   !> @param[in] td_dom    domain structure
146   !> @return  variable structure
147   !-------------------------------------------------------------------
148
149      IMPLICIT NONE
150
151      ! Argument
152      TYPE(TMPP) , INTENT(IN) :: td_mpp
153      INTEGER(i4), INTENT(IN) :: id_varid
154      TYPE(TDOM) , INTENT(IN) :: td_dom
155
156      ! function
157      TYPE(TVAR)              :: tf_var
158
159      ! local variable
160      INTEGER(i4), DIMENSION(1) :: il_ind
161      !----------------------------------------------------------------
162      ! check if mpp exist
163      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
164
165         CALL logger_error(" IOM DOM READ VAR: domain decomposition "//&
166            &              "not define in mpp strcuture "//TRIM(td_mpp%c_name))
167
168      ELSE
169
170         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
171            ! look for variable id
172            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
173            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
174            IF( il_ind(1) /= 0 )THEN
175
176               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
177
178               !!! read variable value
179               CALL iom_dom__read_var_value(td_mpp, tf_var, td_dom)
180
181            ELSE
182               CALL logger_error( &
183                  &  " IOM DOM READ VAR: there is no variable with id "//&
184                  &  TRIM(fct_str(id_varid))//" in processor/file "//&
185                  &  TRIM(td_mpp%t_proc(1)%c_name))
186            ENDIF
187         ELSE
188            CALL logger_error(" IOM DOM READ VAR: can't read variable, mpp "//&
189               &              TRIM(td_mpp%c_name)//" not opened")
190         ENDIF
191
192      ENDIF
193
194   END FUNCTION iom_dom__read_var_id
195   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
196   FUNCTION iom_dom__read_var_name(td_mpp, cd_name, td_dom) &
197         & RESULT (tf_var)
198   !-------------------------------------------------------------------
199   !> @brief This function read variable value in opened mpp files,
200   !> given variable name or standard name, and domain structure.
201   !>
202   !> @details
203   !> Optionally start indices and number of point to be read could be specify.
204   !> as well as East West ovelap of the global domain.
205   !>
206   !> look first for variable name. If it doesn't
207   !> exist in file, look for variable standard name.<br/>
208   !> If variable name is not present, check variable standard name.<br/>
209   !>
210   !> @author J.Paul
211   !> @date October, 2014 - Initial Version
212   !> @date May, 2019
213   !> - copy variable struct without array of value, then read array of value.
214   !>
215   !> @param[in] td_mpp    mpp structure
216   !> @param[in] cd_name   variable name
217   !> @param[in] td_dom    domain structure
218   !> @return  variable structure
219   !-------------------------------------------------------------------
220
221      IMPLICIT NONE
222
223      ! Argument
224      TYPE(TMPP),       INTENT(IN) :: td_mpp
225      CHARACTER(LEN=*), INTENT(IN) :: cd_name
226      TYPE(TDOM)      , INTENT(IN) :: td_dom
227
228      ! function
229      TYPE(TVAR)                   :: tf_var
230
231      ! local variable
232      INTEGER(i4)       :: il_ind
233
234      !----------------------------------------------------------------
235      ! check if mpp exist
236      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
237
238         CALL logger_error( " IOM DOM READ VAR: domain decomposition not define "//&
239            &               " in mpp strcuture "//TRIM(td_mpp%c_name))
240
241      ELSE
242
243         il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
244         IF( il_ind /= 0 )THEN
245
246            tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind), ld_value=.FALSE.)
247
248            !!! read variable value
249            CALL iom_dom__read_var_value( td_mpp, tf_var, td_dom )
250
251         ELSE
252
253            CALL logger_error( &
254               &  " IOM DOM READ VAR: there is no variable with "//&
255               &  "name or standard name "//TRIM(cd_name)//&
256               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
257         ENDIF
258
259      ENDIF
260
261   END FUNCTION iom_dom__read_var_name
262   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
263   SUBROUTINE iom_dom__read_var_value(td_mpp, td_var, td_dom)
264   !-------------------------------------------------------------------
265   !> @brief This subroutine read variable value
266   !> in an mpp structure, given domain structure.
267   !>
268   !> @author J.Paul
269   !> @date October, 2014 - Initial Version
270   !>
271   !> @todo
272   !> - handle north fold
273   !>
274   !> @param[in] td_mpp    mpp structure
275   !> @param[inout] td_var variable structure
276   !> @param[in] td_dom    domain structure
277   !-------------------------------------------------------------------
278
279      IMPLICIT NONE
280
281      ! Argument
282      TYPE(TMPP),   INTENT(IN)    :: td_mpp
283      TYPE(TVAR),   INTENT(INOUT) :: td_var
284      TYPE(TDOM),   INTENT(IN)    :: td_dom
285
286      ! local variable
287      INTEGER(i4)                 :: il_status
288
289      TYPE(TATT)                  :: tl_att
290      TYPE(TMPP)                  :: tl_mpp
291      TYPE(TDOM)                  :: tl_dom
292
293      ! loop indices
294      INTEGER(i4)                 :: jk
295      !----------------------------------------------------------------
296
297      CALL logger_debug(" IOM DOM READ VAR VALUE: name "//&
298      &  TRIM(td_var%c_name)//" "//TRIM(td_var%c_point) )
299      CALL logger_debug(" IOM DOM READ VAR VALUE: ndim "//&
300      &  TRIM(fct_str(td_var%i_ndim)) )
301
302      ! copy mpp structure
303      tl_mpp=mpp_copy(td_mpp)
304      ! forced to keep same id
305      tl_mpp%t_proc(:)%i_id=td_mpp%t_proc(:)%i_id
306
307      ! Allocate space to hold variable value in structure
308      IF( ASSOCIATED(td_var%d_value) )THEN
309         DEALLOCATE(td_var%d_value)
310      ENDIF
311
312      ! copy domain structure
313      tl_dom=dom_copy(td_dom)
314      DO jk=1,ip_maxdim
315         IF( .NOT. td_var%t_dim(jk)%l_use ) tl_dom%t_dim(jk)%i_len = 1
316      ENDDO
317
318      ! use domain dimension
319      td_var%t_dim(1:2)%i_len=tl_dom%t_dim(1:2)%i_len
320
321      ALLOCATE(td_var%d_value( tl_dom%t_dim(1)%i_len, &
322      &                        tl_dom%t_dim(2)%i_len, &
323      &                        td_var%t_dim(3)%i_len, &
324      &                        td_var%t_dim(4)%i_len),&
325      &        stat=il_status)
326      IF(il_status /= 0 )THEN
327
328        CALL logger_error( &
329         &  " IOM DOM READ VAR VALUE: not enough space to put variable "//&
330         &  TRIM(td_var%c_name)//&
331         &  " in variable structure")
332
333      ENDIF
334      CALL logger_debug("IOM DOM READ VAR VALUE: shape ("//&
335      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//&
336      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//&
337      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//&
338      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )
339      ! FillValue by default
340      td_var%d_value(:,:,:,:)=td_var%d_fill
341
342      IF( tl_dom%i_perio0 < 3 .OR. &
343      &   tl_dom%i_jmax /= tl_dom%t_dim0(2)%i_len )THEN
344      ! no north pole
345
346         IF( (tl_dom%i_perio0 == 1 .OR. &
347         &    tl_dom%i_perio0 == 4 .OR. &
348         &    tl_dom%i_perio0 == 6) .AND. &
349         &   tl_dom%i_imin == 1 .AND. &
350         &   tl_dom%i_imax == tl_dom%t_dim0(1)%i_len )THEN
351         ! east west cyclic
352
353            CALL iom_dom__no_pole_cyclic(tl_mpp, td_var, tl_dom)
354
355         ELSEIF( tl_dom%i_imin <= tl_dom%i_imax )THEN
356         ! no east west overlap
357
358            CALL iom_dom__no_pole_no_overlap(tl_mpp, td_var, tl_dom)
359
360            ! no more EW overlap in variable
361            td_var%i_ew=-1
362
363         ELSEIF( (tl_dom%i_perio0 == 1 .OR. &
364         &        tl_dom%i_perio0 == 4 .OR. &
365         &        tl_dom%i_perio0 == 6) .AND. &
366         &       tl_dom%i_imin > tl_dom%i_imax )THEN
367         ! east west overlap
368
369            CALL iom_dom__no_pole_overlap(tl_mpp, td_var, tl_dom)
370
371            ! no more EW overlap in variable
372            td_var%i_ew=-1
373
374         ELSE
375
376            CALL logger_fatal(" IOM DOM READ VAR VALUE: invalid domain definition.")
377
378         ENDIF
379
380      ELSE ! tl_dom%i_jmax == tl_dom%t_dim0(2)%i_len
381         ! north pole
382
383         CALL logger_error("IOM DOM READ VAR VALUE: "//&
384         &                 TRIM(fct_str(tl_dom%i_jmin))//" "//&
385         &                 TRIM(fct_str(tl_dom%i_jmax)) )
386         CALL logger_fatal("IOM DOM READ VAR VALUE: siren is not able to "//&
387         &                 "use north pole now, maybe in the next release")
388      !   IF( tl_dom%i_imin < tl_dom%i_imax )THEN
389      !   ! no east west overlap
390
391      !      CALL iom_dom__pole_no_overlap(tl_mpp, td_var, tl_dom)
392
393      !   ELSEIF(tl_dom%i_imin == tl_dom%i_imax)THEN
394      !   ! east west cyclic
395
396      !      CALL iom_dom__pole_cyclic(tl_mpp, td_var, tl_dom)
397
398      !    ELSE ! tl_dom%i_imin > tl_dom%i_imax
399      !    ! east west overlap
400
401      !      CALL iom_dom__pole_overlap(tl_mpp, td_var, tl_dom)
402
403      !   ENDIF
404      ENDIF
405
406      ! clean
407      CALL mpp_clean(tl_mpp)
408      CALL dom_clean(tl_dom)
409
410      IF( td_var%t_dim(1)%l_use .AND. &
411      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN
412         IF( td_mpp%i_ew >= 0 )THEN
413            tl_att=att_init("ew_overlap",td_mpp%i_ew)
414            CALL var_move_att(td_var,tl_att)
415            ! clean
416            CALL att_clean(tl_att)
417         ENDIF
418      ENDIF
419
420      ! force to change _FillValue to avoid mistake
421      ! with dummy zero _FillValue
422      IF( td_var%d_fill == 0._dp )THEN
423         CALL var_chg_FillValue(td_var)
424      ENDIF
425
426   END SUBROUTINE iom_dom__read_var_value
427   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
428   SUBROUTINE iom_dom__no_pole_no_overlap(td_mpp, td_var, td_dom)
429   !-------------------------------------------------------------------
430   !> @brief This subroutine read variable value
431   !> in an mpp structure.
432   !> @details
433   !> The output domain do not overlap
434   !> north fold boundary or east-west boundary.
435   !>
436   !> @author J.Paul
437   !> @date October, 2014 - Initial Version
438   !>
439   !> @param[in] td_mpp    mpp structure
440   !> @param[inout] td_var variable structure
441   !> @param[in] td_dom    domain structure
442   !-------------------------------------------------------------------
443
444      IMPLICIT NONE
445
446      ! Argument
447      TYPE(TMPP),  INTENT(IN)    :: td_mpp
448      TYPE(TVAR),  INTENT(INOUT) :: td_var
449      TYPE(TDOM),  INTENT(IN)    :: td_dom
450
451      ! local variable
452      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
453      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
454
455      TYPE(TDOM)                :: tl_dom
456
457      ! loop indices
458      !----------------------------------------------------------------
459
460      ! copy domain structure
461      tl_dom=dom_copy(td_dom)
462
463      ! change dimension length if not use
464      IF( .NOT. td_var%t_dim(1)%l_use )THEN
465         tl_dom%i_imin=1 ; tl_dom%i_imax=1
466      ENDIF
467      IF( .NOT. td_var%t_dim(2)%l_use )THEN
468         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
469      ENDIF
470
471      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
472
473      il_count(:)=(/tl_dom%i_imax-tl_dom%i_imin+1, &
474      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
475      &             td_var%t_dim(3)%i_len, &
476      &             td_var%t_dim(4)%i_len/)
477
478      td_var=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
479      &                       il_start(:), il_count(:) )
480
481      CALL dom_clean(tl_dom)
482
483   END SUBROUTINE iom_dom__no_pole_no_overlap
484   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
485   SUBROUTINE iom_dom__no_pole_cyclic(td_mpp, td_var, td_dom)
486   !-------------------------------------------------------------------
487   !> @brief This subroutine read cyclic variable value
488   !> in an mpp structure.
489   !> @details
490   !> The output domain do not overlap north fold boundary.
491   !> However it uses cyclic east-west boundary.
492   !>
493   !> @author J.Paul
494   !> @date October, 2014 - Initial Version
495   !>
496   !> @param[in] td_mpp    mpp structure
497   !> @param[inout] td_var variable structure
498   !> @param[in] td_dom    domain structure
499   !-------------------------------------------------------------------
500
501      IMPLICIT NONE
502
503      ! Argument
504      TYPE(TMPP),   INTENT(IN   ) :: td_mpp
505      TYPE(TVAR),   INTENT(INOUT) :: td_var
506      TYPE(TDOM),   INTENT(IN   ) :: td_dom
507
508      ! local variable
509      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
510      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
511
512      TYPE(TDOM)                :: tl_dom
513
514      ! loop indices
515      !----------------------------------------------------------------
516
517      ! copy domain structure
518      tl_dom=dom_copy(td_dom)
519
520      ! cyclic domain
521      tl_dom%i_imin=1
522      tl_dom%i_imax=tl_dom%t_dim(1)%i_len
523
524      ! change dimension length if not use
525      IF( .NOT. td_var%t_dim(1)%l_use )THEN
526         tl_dom%i_imin=1 ; tl_dom%i_imax=1
527      ENDIF
528      IF( .NOT. td_var%t_dim(2)%l_use )THEN
529         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
530      ENDIF
531
532      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
533
534      il_count(:)=(/tl_dom%i_imax-tl_dom%i_imin+1, &
535      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
536      &             td_var%t_dim(3)%i_len, &
537      &             td_var%t_dim(4)%i_len /)
538
539      td_var=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
540      &                       il_start(:), il_count(:) )
541
542      ! clean
543      CALL dom_clean(tl_dom)
544
545   END SUBROUTINE iom_dom__no_pole_cyclic
546   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
547   SUBROUTINE iom_dom__no_pole_overlap(td_mpp, td_var, td_dom)
548   !-------------------------------------------------------------------
549   !> @brief This subroutine read East West overlap variable value
550   !> in an mpp structure.
551   !> @details
552   !> The output domain do not overlap north fold boundary.
553   !> However it overlaps east-west boundary.
554   !>
555   !> @author J.Paul
556   !> @date October, 2014 - Initial Version
557   !>
558   !> @param[in] td_mpp    mpp structure
559   !> @param[inout] td_var variable structure
560   !> @param[in] td_dom    domain structure
561   !-------------------------------------------------------------------
562
563      IMPLICIT NONE
564
565      ! Argument
566      TYPE(TMPP),   INTENT(IN)    :: td_mpp
567      TYPE(TVAR),   INTENT(INOUT) :: td_var
568      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
569
570      ! local variable
571      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
572      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
573
574      INTEGER(i4)               :: il_dim1
575      INTEGER(i4)               :: il_dim2
576
577      TYPE(TVAR)                :: tl_var1
578      TYPE(TVAR)                :: tl_var2
579
580      TYPE(TDOM)                :: tl_dom
581
582      ! loop indices
583      !----------------------------------------------------------------
584
585      ! copy domain structure
586      tl_dom=dom_copy(td_dom)
587
588      ! change dimension length if not use
589      IF( .NOT. td_var%t_dim(1)%l_use )THEN
590         tl_dom%i_imin=1 ; tl_dom%i_imax=1
591      ENDIF
592      IF( .NOT. td_var%t_dim(2)%l_use )THEN
593         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
594      ENDIF
595
596      ! get first part of domain
597      tl_var1=var_copy(td_var)
598      DEALLOCATE(tl_var1%d_value)
599
600      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
601
602      il_dim1 = td_mpp%t_dim(1)%i_len - td_mpp%i_ew - tl_dom%i_imin + 1
603
604      il_count(:)=(/il_dim1, &
605      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
606      &             td_var%t_dim(3)%i_len, &
607      &             td_var%t_dim(4)%i_len /)
608
609      ! dimension part 1
610      tl_var1%t_dim(:)%i_len=il_count(:)
611
612      ALLOCATE(tl_var1%d_value(tl_var1%t_dim(1)%i_len, &
613      &                        tl_var1%t_dim(2)%i_len, &
614      &                        tl_var1%t_dim(3)%i_len, &
615      &                        tl_var1%t_dim(4)%i_len) )
616
617      tl_var1=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
618      &                        il_start(:), il_count(:) )
619
620      IF( td_var%t_dim(jp_I)%l_use )THEN
621         ! get second part of domain
622         tl_var2=var_copy(td_var)
623         DEALLOCATE(tl_var2%d_value)
624
625         il_start(:)=(/1,tl_dom%i_jmin,1,1/)
626
627         il_dim2 = tl_dom%i_imax
628
629         il_count(:)=(/il_dim2, &
630         &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
631         &             td_var%t_dim(3)%i_len, &
632         &             td_var%t_dim(4)%i_len /)
633
634         ! dimension part 2
635         tl_var2%t_dim(:)%i_len=il_count(:)
636
637         ALLOCATE(tl_var2%d_value(tl_var2%t_dim(1)%i_len, &
638         &                        tl_var2%t_dim(2)%i_len, &
639         &                        tl_var2%t_dim(3)%i_len, &
640         &                        tl_var2%t_dim(4)%i_len) )
641
642         tl_var2=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
643         &                        il_start(:), il_count(:) )
644
645         ! concatenate both part
646         td_var=var_concat(tl_var1, tl_var2, jp_I)
647
648         ! clean
649         CALL var_clean(tl_var1)
650         CALL var_clean(tl_var2)
651      ELSE
652         td_var=var_copy(tl_var1)
653         ! clean
654         CALL var_clean(tl_var1)
655      ENDIF
656
657      ! clean
658      CALL dom_clean(tl_dom)
659
660   END SUBROUTINE iom_dom__no_pole_overlap
661   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
662!   SUBROUTINE iom_dom__pole_no_overlap(td_mpp, td_var, td_dom)
663   !-------------------------------------------------------------------
664   !> @brief This subroutine read north fold variable value
665   !> in an mpp structure.
666   !> @details
667   !> The output domain overlaps
668   !> north fold boundary. However it do not overlap east-west boundary.
669   !>
670   !> @author J.Paul
671   !> @date October, 2014 - Initial Version
672   !>
673   !> @param[in] td_mpp    mpp structure
674   !> @param[inout] td_var variable structure
675   !> @param[in] td_dom    domain structure
676   !-------------------------------------------------------------------
677!
678!      IMPLICIT NONE
679!
680!      ! Argument
681!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
682!      TYPE(TVAR),   INTENT(INOUT) :: td_var
683!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
684!
685!      ! local variable
686!
687!      ! loop indices
688!      !----------------------------------------------------------------
689!
690!   END SUBROUTINE iom_dom__pole_no_overlap
691   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
692!   SUBROUTINE iom_dom__pole_cyclic(td_mpp, td_var, td_dom)
693   !-------------------------------------------------------------------
694   !> @brief This subroutine read semi global variable value
695   !> in an mpp structure.
696   !> @details
697   !> The output domain overlaps north fold boundary.
698   !> and uses cyclic east-west boundary.
699   !>
700   !> @author J.Paul
701   !> @date October, 2014 - Initial Version
702   !>
703   !> @param[in] td_mpp    mpp structure
704   !> @param[inout] td_var variable structure
705   !> @param[in] td_dom    domain structure
706   !> @return variable structure completed
707   !-------------------------------------------------------------------
708!
709!      IMPLICIT NONE
710!
711!      ! Argument
712!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
713!      TYPE(TVAR),   INTENT(INOUT) :: td_var
714!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
715!
716!      ! local variable
717!
718!      ! loop indices
719!      !----------------------------------------------------------------
720!
721!   END SUBROUTINE iom_dom__pole_cyclic
722   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
723!   SUBROUTINE iom_dom__pole_overlap(td_mpp, td_var, td_dom)
724   !-------------------------------------------------------------------
725   !> @brief This subroutine read north fold East West overlap variable value
726   !> in an mpp structure.
727   !> @details
728   !> The output domain overlaps north fold boundary.
729   !> and east-west boundary.
730   !>
731   !> @author J.Paul
732   !> @date October, 2014 - Initial Version
733   !>
734   !> @param[in] td_mpp    mpp structure
735   !> @param[inout] td_var variable structure
736   !> @param[in] td_dom    domain structure
737   !> @return variable structure completed
738   !-------------------------------------------------------------------
739!
740!      IMPLICIT NONE
741!
742!      ! Argument
743!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
744!      TYPE(TVAR),   INTENT(INOUT) :: td_var
745!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
746!
747!      ! local variable
748!
749!      ! loop indices
750!      !----------------------------------------------------------------
751!
752!   END SUBROUTINE iom_dom__pole_overlap
753   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
754END MODULE iom_dom
Note: See TracBrowser for help on using the repository browser.