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 branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90 @ 5260

Last change on this file since 5260 was 5260, checked in by deazer, 9 years ago

Merged branch with Trunk at revision 5253.
Checked with SETTE, passes modified iodef.xml for AMM12 experiment

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