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

source: utils/tools/SIREN/src/addline_deg.f90 @ 12080

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

update nemo trunk

File size: 23.1 KB
Line 
1!----------------------------------------------------------------------
2! MERCATOR OCEAN, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!> @file
5!> @brief
6!> This program add line to all variables of the input file.
7!>
8!> @details
9!> @section sec2 how to
10!>    to add line to file:<br/>
11!> @code{.sh}
12!>    ./SIREN/bin/addline addline.nam
13!> @endcode
14!> the namelist file (**addline.nam**) sets up program parameters.
15!>
16!> to set up program parameters, you just have to fill the namelist file (**add_line.nam**).
17!> @note
18!>    you could find a template of the namelist in templates directory.
19!>
20!>    create_bathy.nam comprise 4 namelists:<br/>
21!>       - **namlog** to set logger parameters
22!>       - **namcfg** to set configuration file parameters
23!>       - **namsrc** to set source grid parameters
24!>       - **namout** to set output parameters
25!>
26!>    here after, each sub-namelist parameters is detailed.
27!>    @note
28!>       default values are specified between brackets
29!>
30!> @subsection sublog namlog
31!>    the logger sub-namelist parameters are :
32!>
33!>    - **cn_logfile** [@a addline.log]<br/>
34!>       logger filename
35!>
36!>    - **cn_verbosity** [@a warning]<br/>
37!>       verbosity level, choose between :
38!>          - trace
39!>          - debug
40!>          - info
41!>          - warning
42!>          - error
43!>          - fatal
44!>          - none
45!>
46!>    - **in_maxerror** [@a 5]<br/>
47!>       maximum number of error allowed
48!>
49!> @subsection subcfg namcfg
50!>    the configuration sub-namelist parameters are :
51!>
52!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
53!>       path to the variable configuration file.<br/>
54!>       the variable configuration file defines standard name,
55!>       default interpolation method, axis,...
56!>       to be used for some known variables.<br/>
57!>
58!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/>
59!>       path to the dimension configuration file.<br/>
60!>       the dimension configuration file defines dimensions allowed.<br/>
61!>
62!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/>
63!>       path to the useless (dummy) configuration file.<br/>
64!>       the dummy configuration file defines useless
65!>       dimension or variable. these dimension(s) or variable(s) will not be
66!>       processed.<br/>
67!>
68!> @subsection subsrc namsrc
69!>    the source/coarse grid sub-namelist parameters are :
70!>
71!>    - **cn_coord0** [@a ]<br/>
72!>       path to the coordinate file
73!>
74!>    - **in_perio0** [@a ]<br/>
75!>       NEMO periodicity index<br/>
76!>       the NEMO periodicity could be choose between 0 to 6:
77!>       <dl>
78!>          <dt>in_perio=0</dt>
79!>          <dd>standard regional model</dd>
80!>          <dt>in_perio=1</dt>
81!>          <dd>east-west cyclic model</dd>
82!>          <dt>in_perio=2</dt>
83!>          <dd>model with symmetric boundary condition across the equator</dd>
84!>          <dt>in_perio=3</dt>
85!>          <dd>regional model with North fold boundary and T-point pivot</dd>
86!>          <dt>in_perio=4</dt>
87!>          <dd>global model with a T-point pivot.<br/>
88!>          example: ORCA2, ORCA025, ORCA12</dd>
89!>          <dt>in_perio=5</dt>
90!>          <dd>regional model with North fold boundary and F-point pivot</dd>
91!>          <dt>in_perio=6</dt>
92!>          <dd>global model with a F-point pivot<br/>
93!>          example: ORCA05</dd>
94!>          </dd>
95!>       </dl>
96!>       @sa For more information see @ref md_src_docsrc_6_perio
97!>       and Model Boundary Condition paragraph in the
98!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
99!>
100!> @subsection subvar namvar
101!>    the variable sub-namelist parameters are :
102!>
103!>    - **cn_varfile** [@a ]<br/>
104!>       list of variable, and associated file
105!>
106!>       *cn_varfile* is the path and filename of the file where find
107!>       variable.
108!>       @note
109!>          *cn_varfile* could be a matrix of value, if you want to handwrite
110!>          variable value.<br/>
111!>          the variable array of value is split into equal subdomain.<br/>
112!>          each subdomain is filled with the corresponding value
113!>          of the matrix.<br/>         
114!>          separators used to defined matrix are:
115!>             - ',' for line
116!>             - '/' for row
117!>             Example:<br/>
118!>                3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
119!>                                      3 & 2 & 3 \\
120!>                                      1 & 4 & 5 \end{array} \right) @f$
121!>
122!>       Examples:
123!>          - 'Bathymetry:gridT.nc'
124!>
125!>       @note
126!>          Optionnaly, NEMO periodicity could be added following the filename.
127!>          the periodicity must be separated by ';'
128!>
129!>       Example:
130!>          - 'Bathymetry:gridT.nc ; perio=4'<br/>
131!>
132!>    - **cn_varinfo** [@a ]<br/>
133!>       list of variable and extra information about request(s) to be used<br/>
134!>
135!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
136!>       it is composed of the variable name follow by ':',
137!>       then request(s) to be used on this variable.<br/>
138!>       request could be:
139!>          - int = interpolation method
140!>          - ext = extrapolation method
141!>          - flt = filter method
142!>          - min = minimum value
143!>          - max = maximum value
144!>          - unt = new units
145!>          - unf = unit scale factor (linked to new units)
146!>
147!>             requests must be separated by ';'.<br/>
148!>             order of requests does not matter.<br/>
149!>
150!>       informations about available method could be find in @ref interp,
151!>       @ref extrap and @ref filter modules.<br/>
152!>       Example:
153!>          - 'Bathymetry: flt=2*hamming(2,3); min=0'
154!>
155!>       @note
156!>          If you do not specify a method which is required,
157!>          default one is apply.
158!>
159!> @subsection subout namout
160!>    the output sub-namelist parameter is :
161!>
162!>    - **cn_fileout** [@a addline_deg.nc]<br/>
163!>       output filename
164!>    - @b ln_extrap [@a .FALSE.]<br/>
165!>       extrapolate extra line
166!>    - @b ln_copy [@a .FALSE.]<br/>
167!>       copy extra line from above
168!>    - **in_nproc** [@a 1]<br/>
169!>       number of processor to be used
170!>    - **in_niproc** [@a 1]<br/>
171!>       i-direction number of processor
172!>    - **in_njproc** [@a 1]<br/>
173!>       j-direction numebr of processor
174!>
175!> <hr>
176!> @author J.Paul
177!> @date October, 2015 - Initial Version
178!>
179!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
180!----------------------------------------------------------------------
181PROGRAM addline_deg
182
183   USE global                          ! global variable
184   USE kind                            ! F90 kind parameter
185   USE logger                          ! log file manager
186   USE fct                             ! basic useful function
187   USE date                            ! date manager
188   USE att                             ! attribute manager
189   USE dim                             ! dimension manager
190   USE var                             ! variable manager
191   USE file                            ! file manager
192   USE multi                           ! multi file manager
193   USE iom                             ! I/O manager
194   USE grid                            ! grid manager
195   USE extrap                          ! extrapolation manager
196   USE interp                          ! interpolation manager
197   USE filter                          ! filter manager
198   USE mpp                             ! MPP manager
199   USE iom_mpp                         ! MPP I/O manager
200
201   IMPLICIT NONE
202
203   ! local variable
204   CHARACTER(LEN=lc)                                  :: cl_namelist
205   CHARACTER(LEN=lc)                                  :: cl_date
206
207   INTEGER(i4)                                        :: il_narg
208   INTEGER(i4)                                        :: il_status
209   INTEGER(i4)                                        :: il_fileid
210   INTEGER(i4)                                        :: il_varid
211   INTEGER(i4)                                        :: il_attid
212   INTEGER(i4)                                        :: il_index
213   INTEGER(i4)                                        :: il_nvar
214
215   LOGICAL                                            :: ll_exist
216
217   TYPE(TMPP)                                         :: tl_coord0
218   TYPE(TMPP)                                         :: tl_mpp
219   TYPE(TMPP)                                         :: tl_mppout
220
221   TYPE(TATT)                                         :: tl_att
222   
223   TYPE(TVAR)                                         :: tl_lon
224   TYPE(TVAR)                                         :: tl_lat
225   TYPE(TVAR)                                         :: tl_depth
226   TYPE(TVAR)                                         :: tl_time
227
228   TYPE(TVAR)                                         :: tl_tmp
229   TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE       :: tl_var
230   
231   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
232
233   TYPE(TMULTI)                                       :: tl_multi
234
235   ! loop indices
236   INTEGER(i4) :: ji
237   INTEGER(i4) :: jj
238   INTEGER(i4) :: jk
239   INTEGER(i4) :: jvar
240
241   ! namelist variable
242   ! namlog
243   CHARACTER(LEN=lc)                       :: cn_logfile = 'addline.log' 
244   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
245   INTEGER(i4)                             :: in_maxerror = 5
246
247   ! namcfg
248   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg' 
249   CHARACTER(LEN=lc)                       :: cn_dimcfg = 'dimension.cfg' 
250   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
251
252   ! namsrc
253   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
254   INTEGER(i4)                             :: in_perio0 = -1
255
256   ! namvar
257   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
258   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
259
260   ! namout
261   CHARACTER(LEN=lc)                       :: cn_fileout = 'addline_deg.nc' 
262   LOGICAL                                 :: ln_extrap  = .FALSE.
263   LOGICAL                                 :: ln_copy    = .FALSE.
264   INTEGER(i4)                             :: in_nproc   = 0
265   INTEGER(i4)                             :: in_niproc  = 0
266   INTEGER(i4)                             :: in_njproc  = 0
267   CHARACTER(LEN=lc)                       :: cn_type    = 'cdf'
268   !-------------------------------------------------------------------
269
270   NAMELIST /namlog/ &   !< logger namelist
271   &  cn_logfile,    &   !< log file
272   &  cn_verbosity,  &   !< log verbosity
273   &  in_maxerror        !< logger maximum error
274
275   NAMELIST /namcfg/ &   !< configuration namelist
276   &  cn_varcfg, &       !< variable configuration file
277   &  cn_dimcfg, &       !< dimension configuration file
278   &  cn_dumcfg          !< dummy configuration file
279
280   NAMELIST /namsrc/ &   !< source/coarse grid namelist
281   &  cn_coord0,  &      !< coordinate file
282   &  in_perio0          !< periodicity index
283   
284   NAMELIST /namvar/ &   !< variable namelist
285   &  cn_varinfo, &      !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
286   &  cn_varfile         !< list of variable file
287
288   NAMELIST /namout/ &   !< output namlist
289   &  cn_fileout, &      !< fine grid bathymetry file
290   &  ln_extrap, &
291   &  ln_copy,   &
292   &  in_niproc,  &     !< i-direction number of processor
293   &  in_njproc,  &     !< j-direction numebr of processor
294   &  in_nproc,   &     !< number of processor to be used
295   &  cn_type           !< output type format (dimg, cdf)
296   !-------------------------------------------------------------------
297
298   ! namelist
299   ! get namelist
300   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
301   IF( il_narg/=1 )THEN
302      PRINT *,"ERROR in addline: need a namelist"
303      STOP
304   ELSE
305      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
306   ENDIF
307 
308   ! read namelist
309   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
310   IF( ll_exist )THEN
311 
312      il_fileid=fct_getunit()
313
314      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
315      &                FORM='FORMATTED',       &
316      &                ACCESS='SEQUENTIAL',    &
317      &                STATUS='OLD',           &
318      &                ACTION='READ',          &
319      &                IOSTAT=il_status)
320      CALL fct_err(il_status)
321      IF( il_status /= 0 )THEN
322         PRINT *,"ERROR in addline: error opening "//TRIM(cl_namelist)
323         STOP
324      ENDIF
325
326      READ( il_fileid, NML = namlog )
327      ! define log file
328      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
329      CALL logger_header()
330
331      READ( il_fileid, NML = namcfg )
332      ! get variable extra information
333      CALL var_def_extra(TRIM(cn_varcfg))
334
335      ! get dimension allowed
336      CALL dim_def_extra(TRIM(cn_dimcfg))
337
338      ! get dummy variable
339      CALL var_get_dummy(TRIM(cn_dumcfg))
340      ! get dummy dimension
341      CALL dim_get_dummy(TRIM(cn_dumcfg))
342      ! get dummy attribute
343      CALL att_get_dummy(TRIM(cn_dumcfg))
344
345      READ( il_fileid, NML = namsrc )
346      READ( il_fileid, NML = namvar )
347      ! add user change in extra information
348      CALL var_chg_extra( cn_varinfo )
349      ! match variable with file
350      tl_multi=multi_init(cn_varfile)
351     
352      READ( il_fileid, NML = namout )
353
354      CLOSE( il_fileid, IOSTAT=il_status )
355      CALL fct_err(il_status)
356      IF( il_status /= 0 )THEN
357         CALL logger_error("ADD LINE: closing "//TRIM(cl_namelist))
358      ENDIF
359
360   ELSE
361
362      PRINT *,"ERROR in addline: can't find "//TRIM(cl_namelist)
363      STOP
364
365   ENDIF
366
367   CALL multi_print(tl_multi)
368
369   ! open files
370   IF( cn_coord0 /= '' )THEN
371      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
372      CALL grid_get_info(tl_coord0)
373   ELSE
374      CALL logger_fatal("ADD LINE: no coarse grid coordinate found. "//&
375      &     "check namelist")     
376   ENDIF
377
378   ! check
379   ! check output file do not already exist
380   print *,'cn_fileout ',TRIM(cn_fileout)
381   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
382   IF( ll_exist )THEN
383      CALL logger_fatal("ADD LINE: output file "//TRIM(cn_fileout)//&
384      &  " already exist.")
385   ENDIF
386
387   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
388      CALL logger_error("ADD LINE: no mpp file to work on. "//&
389      &                 "check cn_varfile in namelist.")
390   ELSE
391
392      ALLOCATE( tl_var( tl_multi%i_nvar ) )
393      jk=0
394      DO ji=1,tl_multi%i_nmpp
395     
396         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
397
398            CALL logger_fatal("ADD LINE: no variable to work on for "//&
399            &                 "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//&
400            &                 ". check cn_varfile in namelist.")
401         ELSE
402
403            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
404            tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) )
405            CALL grid_get_info(tl_mpp)
406
407            ! open mpp file
408            CALL iom_mpp_open(tl_mpp)
409
410            ! get or check depth value
411            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN
412               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid
413               IF( ASSOCIATED(tl_depth%d_value) )THEN
414                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid)
415                  IF( ANY( tl_depth%d_value(:,:,:,:) /= &
416                  &        tl_tmp%d_value(:,:,:,:) ) )THEN
417                     CALL logger_fatal("ADD LINE: depth value from "//&
418                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
419                     &  " to those from former file(s).")
420                  ENDIF
421                  CALL var_clean(tl_tmp)
422               ELSE
423                  tl_depth=iom_mpp_read_var(tl_mpp,il_varid)
424               ENDIF
425            ENDIF
426
427            ! get or check time value
428            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN
429               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid
430               IF( ASSOCIATED(tl_time%d_value) )THEN
431                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid)
432                  IF( ANY( tl_time%d_value(:,:,:,:) /= &
433                  &        tl_tmp%d_value(:,:,:,:) ) )THEN
434                     CALL logger_fatal("ADD LINE: time value from "//&
435                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
436                     &  " to those from former file(s).")
437                  ENDIF
438                  CALL var_clean(tl_tmp)
439               ELSE
440                  tl_time=iom_mpp_read_var(tl_mpp,il_varid)
441               ENDIF
442            ENDIF
443
444            ! close mpp file
445            CALL iom_mpp_close(tl_mpp)
446
447            !- add line to input file variable
448            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
449               jk=jk+1
450               tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
451               WRITE(*,'(2x,a)') "work on variable "//TRIM(tl_tmp%c_name)
452           
453               tl_var(jk)=add_line( tl_tmp, tl_mpp, &
454               &                    tl_coord0 )
455
456               IF( ln_copy )THEN
457                  tl_var(jk)%d_value(:,2,:,:)=tl_var(jk)%d_value(:,3,:,:)
458               ELSEIF( ln_extrap )THEN
459                  ! extrapolate variable
460                  CALL extrap_fill_value( tl_var(jk) )
461               ENDIF
462               ! clean
463               CALL var_clean(tl_tmp)
464
465            ENDDO
466
467         ENDIF
468
469      ENDDO
470
471   ENDIF
472
473   il_nvar=tl_multi%i_nvar
474   ! clean
475   CALL multi_clean(tl_multi)
476
477   ! create file
478   IF( in_niproc == 0 .AND. &
479   &   in_njproc == 0 .AND. &
480   &   in_nproc == 0 )THEN
481      in_niproc = 1
482      in_njproc = 1
483      in_nproc = 1
484   ENDIF
485
486   ! add dimension
487   tl_dim(:)=var_max_dim(tl_var(:))
488
489   DO ji=1,il_nvar
490
491      IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN
492         tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), &
493         &                   in_niproc, in_njproc, in_nproc, &
494         &                   cd_type=cn_type)
495         EXIT
496      ENDIF
497
498   ENDDO
499
500   DO ji=1,ip_maxdim
501
502      IF( tl_dim(ji)%l_use )THEN
503         CALL mpp_move_dim(tl_mppout, tl_dim(ji))
504         SELECT CASE(TRIM(tl_dim(ji)%c_sname))
505         CASE('z','t')
506            DO jj=1,tl_mppout%i_nproc
507               CALL file_add_dim(tl_mppout%t_proc(jj), tl_dim(ji))
508            ENDDO
509         END SELECT
510      ENDIF
511
512   ENDDO
513
514   ! add variables
515   IF( ALL( tl_dim(1:2)%l_use ) )THEN
516
517      ! open mpp files
518      CALL iom_mpp_open(tl_coord0)
519
520      ! add longitude
521      tl_lon=iom_mpp_read_var(tl_coord0,'longitude')
522      CALL mpp_add_var(tl_mppout, tl_lon)
523      CALL var_clean(tl_lon)
524
525      ! add latitude
526      tl_lat=iom_mpp_read_var(tl_coord0,'latitude')
527      CALL mpp_add_var(tl_mppout, tl_lat)
528      CALL var_clean(tl_lat)
529
530      ! close mpp files
531      CALL iom_mpp_close(tl_coord0)
532
533   ENDIF
534
535   IF( tl_dim(3)%l_use )THEN
536      IF( ASSOCIATED(tl_depth%d_value) )THEN
537         ! add depth
538         CALL mpp_add_var(tl_mppout, tl_depth)
539      ELSE
540         CALL logger_warn("CREATE RESTART: no value for depth variable.")
541      ENDIF
542   ENDIF
543   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
544
545   IF( tl_dim(4)%l_use )THEN
546      IF( ASSOCIATED(tl_time%d_value) )THEN
547         ! add time
548         CALL mpp_add_var(tl_mppout, tl_time)
549      ELSE
550         CALL logger_warn("CREATE RESTART: no value for time variable.")
551      ENDIF
552   ENDIF
553   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
554
555   ! add other variables
556   DO jvar=il_nvar,1,-1
557      ! check if variable already add
558      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
559      IF( il_index == 0 )THEN
560         CALL mpp_add_var(tl_mppout, tl_var(jvar))
561         CALL var_clean(tl_var(jvar))
562      ENDIF
563   ENDDO
564
565   ! add some attribute
566   tl_att=att_init("Created_by","SIREN addline_deg")
567   CALL mpp_add_att(tl_mppout, tl_att)
568
569   cl_date=date_print(date_now())
570   tl_att=att_init("Creation_date",cl_date)
571   CALL mpp_add_att(tl_mppout, tl_att)
572
573   ! add attribute periodicity
574   il_attid=0
575   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
576      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'periodicity')
577   ENDIF
578   IF( tl_coord0%i_perio >= 0 .AND. il_attid == 0 )THEN
579      tl_att=att_init('periodicity',tl_coord0%i_perio)
580      CALL mpp_add_att(tl_mppout,tl_att)
581   ENDIF
582
583   il_attid=0
584   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
585      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'ew_overlap')
586   ENDIF
587   IF( tl_coord0%i_ew >= 0 .AND. il_attid == 0 )THEN
588      tl_att=att_init('ew_overlap',tl_coord0%i_ew)
589      CALL mpp_add_att(tl_mppout,tl_att)
590   ENDIF
591   
592   ! print
593   CALL mpp_print(tl_mppout)
594
595   ! create file
596   CALL iom_mpp_create(tl_mppout)
597
598   ! write file
599   CALL iom_mpp_write_file(tl_mppout)
600   ! close file
601   CALL iom_mpp_close(tl_mppout)
602
603   ! clean
604   CALL att_clean(tl_att)
605   CALL var_clean(tl_var(:))
606   DEALLOCATE(tl_var)
607
608   CALL mpp_clean(tl_mppout)
609   CALL mpp_clean(tl_coord0)
610
611   ! close log file
612   CALL logger_footer()
613   CALL logger_close()
614
615CONTAINS
616   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
617   FUNCTION add_line(td_var, td_mpp, td_coord) &
618         &  RESULT(tf_var)
619   !-------------------------------------------------------------------
620   !> @brief
621   !> This function add line to variable and return variable structure
622   !>
623   !> @author J.Paul
624   !> @date October, 2015 - Initial Version
625   !>
626   !> @param[in] td_var    variable structure
627   !> @param[in] td_mpp    mpp file structure
628   !> @param[in] td_coord  coordinate file structure
629   !> @return variable structure
630   !-------------------------------------------------------------------
631     
632      IMPLICIT NONE
633
634      ! Argument
635      TYPE(TVAR), INTENT(IN) :: td_var 
636      TYPE(TMPP), INTENT(IN) :: td_mpp
637      TYPE(TMPP), INTENT(IN) :: td_coord
638
639      ! function
640      TYPE(TVAR)             :: tf_var
641
642      ! local variable
643      INTEGER(i4), DIMENSION(2,2) :: il_ghost
644
645      TYPE(TMPP)  :: tl_mpp
646
647      TYPE(TATT)  :: tl_att
648
649      TYPE(TDIM), DIMENSION(ip_maxdim)  :: tl_dim
650      ! loop indices
651      !----------------------------------------------------------------
652
653      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
654         CALL logger_error("ADD LINE: no processor associated "//&
655         &  "to mpp "//TRIM(td_mpp%c_name))
656      ELSE
657
658         !init
659         tl_mpp=mpp_copy(td_mpp)
660         il_ghost(:,:)=0
661
662         tl_dim(:)=dim_copy(td_coord%t_dim(:))
663
664         ! ghost cell to be added
665         il_ghost(jp_I,:)=(/0,0/)
666         il_ghost(jp_J,:)=(/1,0/)
667
668         ! open mpp files
669         CALL iom_mpp_open(tl_mpp)
670
671         ! read variable
672         tf_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name))
673
674         ! close mpp file
675         CALL iom_mpp_close(tl_mpp)
676
677         ! add ghost cell
678         CALL grid_add_ghost(tf_var,il_ghost(:,:))
679
680         ! add attribute to variable
681         tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
682         CALL var_move_att(tf_var, tl_att)         
683
684         tl_att=att_init('add_i_line',(/il_ghost(jp_I,1), il_ghost(jp_I,2)/))
685         CALL var_move_att(tf_var, tl_att)
686
687         tl_att=att_init('add_j_line',(/il_ghost(jp_J,1), il_ghost(jp_J,2)/))
688         CALL var_move_att(tf_var, tl_att)
689
690         ! clean structure
691         CALL att_clean(tl_att)
692         CALL mpp_clean(tl_mpp)
693      ENDIF
694
695   END FUNCTION add_line
696   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
697END PROGRAM 
Note: See TracBrowser for help on using the repository browser.