source: utils/tools/NESTING/src/agrif_create_restart.f90 @ 10398

Last change on this file since 10398 was 10398, checked in by clem, 23 months ago

BGC restart should now work in the nesting tool. All of that must of course be tested in realistic simulations. Waiting for the feedbacks…

  • Property svn:keywords set to Id
File size: 20.4 KB
Line 
1!
2!************************************************************************
3! Fortran 95 OPA Nesting tools                  *
4!                          *
5!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr) *
6!                          *
7!************************************************************************
8!
9PROGRAM create_rstrt
10  !
11  USE NETCDF
12  USE bilinear_interp
13  USE bicubic_interp
14  USE agrif_readwrite
15  USE io_netcdf 
16  USE agrif_extrapolation
17  USE agrif_interpolation
18  USE agrif_partial_steps       
19  USE agrif_connect_topo
20  !
21  IMPLICIT NONE
22  !
23  !************************************************************************
24  !                           *
25  ! PROGRAM  CREATE_RSTRT                    *
26  !                           *
27  ! program to interpolate parent grid restart file to child grid    *
28  !                           *
29  !                           *
30  !Interpolation is carried out using bilinear interpolation      *
31  !routine from SCRIP package                *     
32  !                           *
33  !http://climate.lanl.gov/Software/SCRIP/            *
34  !************************************************************************
35  !
36  ! variables declaration
37  !     
38  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
39  CHARACTER*20 :: vert_coord_name
40  CHARACTER*1 :: posvar
41  CHARACTER*100 :: Child_file,Childcoordinates,varname,Child_Bathy_Level,Child_Bathy_Meter   
42  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar3d => NULL()
43  REAL*8, POINTER, DIMENSION(:,:,:,:) :: un,ub,vn,vb,tn,tb,sn,sb,e3t_n,e3t_b => NULL()
44  REAL*8, POINTER, DIMENSION(:,:,:) :: sshn,sshb => NULL()     
45  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
46  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
47  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D => NULL()
48  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabtemp4D => NULL()
49  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
50  REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
51  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
52  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
53  LOGICAL :: Interpolation,Extrapolation,Pacifique
54  INTEGER :: narg,iargc,ncid,x,y,z,z_a,x_a,y_a,z_b,nbvert_lev
55  REAL*8 :: now_wght,before_wght
56  INTEGER :: status,ii,jk
57  CHARACTER(len=20),DIMENSION(4) :: dimnames
58  CHARACTER(len=80) :: namelistname
59  TYPE(Coordinates) :: G0,G1
60  REAL*8 :: tabtemp0dreal
61  CHARACTER(len=20) :: timedimname
62
63  LOGICAL, PARAMETER :: conservation = .FALSE.
64  !     
65  !       
66  narg = iargc()
67  IF (narg == 0) THEN
68     namelistname = 'namelist.input'
69  ELSE
70     CALL getarg(1,namelistname)
71  ENDIF
72  !
73  ! read input file
74  !
75  CALL read_namelist(namelistname)
76  !     
77  IF(TRIM(restart_file) == '') THEN
78     WRITE(*,*) 'no restart file specified in ',TRIM(namelistname)
79     STOP
80  END IF
81
82  IF (iom_activated) THEN
83     timedimname = 'time_counter'
84  ELSE
85     timedimname='time'
86  ENDIF
87
88  !
89  WRITE(*,*) ''
90  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_file)
91  WRITE(*,*) ''
92  !
93  CALL Read_Ncdf_VarName(restart_file,Ncdf_varname)
94  !       
95  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
96  IF( TRIM(parent_bathy_level) /= '' )   CALL set_child_name(parent_bathy_level,Child_Bathy_Level) 
97  IF( TRIM(parent_bathy_meter) /= '' )   CALL set_child_name(parent_bathy_meter,Child_Bathy_Meter)   
98  !
99  ! create this file
100  !
101  CALL set_child_name(restart_file,Child_file)
102  status = nf90_create(Child_file,NF90_WRITE,ncid)
103  status = nf90_close(ncid)
104  WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)     
105  WRITE(*,*) ''
106
107  !
108  ! read dimensions in parent restart file
109  !
110  CALL Read_Ncdf_dim('x',restart_file,x)
111  CALL Read_Ncdf_dim('y',restart_file,y) 
112  CALL Read_Ncdf_dim('nav_lev',restart_file,z)
113  IF (.NOT.iom_activated) THEN
114     CALL Read_Ncdf_dim('x_a',restart_file,x_a)
115     CALL Read_Ncdf_dim('y_a',restart_file,y_a)
116     CALL Read_Ncdf_dim('z_a',restart_file,z_a)
117     CALL Read_Ncdf_dim('z_b',restart_file,z_b)
118  ENDIF
119
120  IF( z .NE. N ) THEN
121     WRITE(*,*) '***'
122     WRITE(*,*) 'Number of vertical levels doesn t match between namelist and restart file'
123     WRITE(*,*) 'Please check the values in namelist file'
124     STOP
125  ENDIF
126  !
127  ! mask initialization for extrapolation and interpolation
128  !
129  WRITE(*,*) 'mask initialisation on coarse and fine grids'
130  !           
131  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
132  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
133  !
134  !longitude modification if child domain covers Pacific ocean area
135  !     
136  IF( Pacifique ) THEN
137     !
138     WHERE( G0%nav_lon < 0 )
139        G0%nav_lon = G0%nav_lon + 360.
140     END WHERE
141     !             
142     WHERE( G1%nav_lon < 0 )
143        G1%nav_lon = G1%nav_lon + 360.
144     END WHERE
145     !
146  ENDIF
147  !
148  ! one needs bathy_level
149  IF( TRIM(parent_bathy_level) /= '' ) THEN
150     status = Read_bathy_level(TRIM(parent_bathy_level),G0)
151     status = Read_bathy_level(TRIM(child_bathy_level),G1)
152  ELSE
153     status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
154     status = read_bathy_meter(TRIM(child_bathy_meter),G1)
155     CALL meter_to_levels(G0)
156     CALL meter_to_levels(G1)
157  ENDIF
158  ! get masks
159  CALL Init_mask(parent_bathy_level,G0,x,y)
160  CALL Init_mask(child_bathy_level,G1,1,1)
161
162  G0%tmask = 1.   
163
164  DO jk=1,z
165     ALLOCATE(tabvar1(x,y,1,1))
166     CALL Read_Ncdf_var('sn',TRIM(restart_file),tabvar1,1,jk)
167     WHERE( tabvar1(:,:,1,1) == 0. ) 
168        G0%tmask(:,:,jk) = 0.
169     END WHERE
170     DEALLOCATE(tabvar1)
171  END DO
172  !
173  G0%umask(1:x-1,:,:) = G0%tmask(1:x-1,:,:)*G0%tmask(2:x,:,:)
174  G0%umask(x,:,:)     = G0%tmask(x,:,:)
175  G0%vmask(:,1:y-1,:) = G0%tmask(:,1:y-1,:)*G0%tmask(:,2:y,:)
176  G0%vmask(:,y,:)     = G0%tmask(:,y,:)
177  !     
178  G0%fmask(1:x-1,1:y-1,:) = G0%tmask(1:x-1,1:y-1,:)*G0%tmask(2:x,1:y-1,:)* &
179     &                      G0%tmask(1:x-1,2:y,:)*G0%tmask(2:x,2:y,:) 
180  G0%fmask(x,:,:) = G0%tmask(x,:,:)
181  G0%fmask(:,y,:) = G0%tmask(:,y,:)
182  !
183  !
184  ! write dimensions in output file
185  WRITE(*,*) 'write dimensions'
186  !         
187  CALL Write_Ncdf_dim('x',Child_file,nxfin)
188  CALL Write_Ncdf_dim('y',Child_file,nyfin)
189  CALL Write_Ncdf_dim('nav_lev',Child_file,z)
190  CALL Write_Ncdf_dim(TRIM(timedimname),Child_file,0) 
191  IF (.NOT.iom_activated) THEN
192     CALL Write_Ncdf_dim('x_a',Child_file,x_a)
193     CALL Write_Ncdf_dim('y_a',Child_file,y_a)
194     CALL Write_Ncdf_dim('z_a',Child_file,z_a)
195     CALL Write_Ncdf_dim('z_b',Child_file,z_b)
196  ENDIF
197  !
198  !
199  !
200  !
201  DO ii = 1,SIZE(Ncdf_varname)     
202     !     
203     ! loop on variables names
204     varname = TRIM(Ncdf_varname(ii))
205     WRITE(*,*) 'var = ',TRIM(varname)     
206     !     
207     SELECT CASE (TRIM(varname))
208        !
209     CASE('nav_lon')
210        CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),tabtemp2D) 
211        CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,tabtemp2D,'float')
212        CALL Copy_Ncdf_att('nav_lon',TRIM(restart_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
213        DEALLOCATE(tabtemp2D)
214        Interpolation = .FALSE.
215        !       
216     CASE('nav_lat')             
217        CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),tabtemp2D) 
218        CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,tabtemp2D,'float')
219        CALL Copy_Ncdf_att('nav_lat',TRIM(restart_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
220        DEALLOCATE(tabtemp2D)
221        Interpolation = .FALSE.
222        !
223     CASE('nav_lev')
224        CALL Read_Ncdf_var('nav_lev',TRIM(restart_file),nav_lev) 
225        CALL Write_Ncdf_var('nav_lev','nav_lev',Child_file,nav_lev,'float')
226        CALL Copy_Ncdf_att('nav_lev',TRIM(restart_file),Child_file)     
227        Interpolation = .FALSE.
228        !
229     CASE('time')
230        CALL Read_Ncdf_var('time',TRIM(restart_file),tabtemp1D) 
231        CALL Write_Ncdf_var('time',TRIM(timedimname),Child_file,tabtemp1D,'float')
232        CALL Copy_Ncdf_att('time',TRIM(restart_file),Child_file) 
233        DEALLOCATE(tabtemp1D)
234        Interpolation = .FALSE.
235        !
236     CASE('time_counter')
237        CALL Read_Ncdf_var('time_counter',TRIM(restart_file),tabtemp1D) 
238        tabtemp1D = tabtemp1D * rhot
239        CALL Write_Ncdf_var('time_counter',TRIM(timedimname),Child_file,tabtemp1D,'double')
240        CALL Copy_Ncdf_att('time_counter',TRIM(restart_file),Child_file) 
241        DEALLOCATE(tabtemp1D)
242        Interpolation = .FALSE.
243        !
244     CASE('kt','ndastp','adatrj','ntime','nn_fsbc','rdt') 
245        IF (iom_activated) THEN
246           CALL Read_Ncdf_var(TRIM(varname),TRIM(restart_file),tabtemp0dreal) 
247           SELECT CASE (TRIM(varname))
248           CASE('rdt')
249              tabtemp0dreal = tabtemp0dreal / rhot
250           CASE('kt')
251              tabtemp0dreal = tabtemp0dreal * rhot
252           END SELECT
253           CALL Write_Ncdf_var(TRIM(varname),Child_file,tabtemp0dreal,'double')
254        ELSE
255           CALL Read_Ncdf_var(TRIM(varname),TRIM(restart_file),tabtemp4D) 
256           dimnames(1)='x_a'
257           dimnames(2)='y_a'
258           dimnames(3)='z_b'
259           dimnames(4)=TRIM(timedimname)           
260           CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabtemp4D,'double')
261           DEALLOCATE(tabtemp4D)
262        ENDIF
263        CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_file),Child_file) 
264        Interpolation = .FALSE.
265        !
266     CASE('frc_v','frc_t','frc_s') 
267        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabtemp0dreal) 
268        CALL Write_Ncdf_var(varname,Child_file,tabtemp0dreal,'double')
269        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file) 
270        Interpolation = .FALSE.
271        !
272        ! Variable interpolation according to their position on grid
273        !                                   
274     CASE('ssu_m','utau_b','un_bf','un','ub') 
275        IF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 4 ) THEN
276           vert_coord_name = 'nav_lev'
277        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 3 ) THEN
278           vert_coord_name = '1'
279        ENDIF
280        posvar='U'
281        Interpolation = .TRUE. 
282        !
283     CASE('ssv_m','vtau_b','vn_bf','vn','vb') 
284        IF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 4 ) THEN
285           vert_coord_name = 'nav_lev'
286        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 3 ) THEN
287           vert_coord_name = '1'
288        ENDIF
289        posvar='V'
290        Interpolation = .TRUE. 
291        !
292     CASE DEFAULT
293        IF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 4 ) THEN
294           vert_coord_name = 'nav_lev'
295        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 3 ) THEN
296           vert_coord_name = '1'
297        ENDIF
298        posvar='T'
299        Interpolation = .TRUE.           
300        !     
301     END SELECT
302     !     
303     ! --- start interpolation --- !
304     IF( Interpolation ) THEN
305        !       
306        IF( vert_coord_name == '1' ) THEN
307           nbvert_lev = 1
308        ELSE
309           nbvert_lev = z
310        ENDIF
311        !
312
313        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),nbvert_lev))                             
314        ALLOCATE(tabvar1(x,y,1,2))
315        ALLOCATE(tabvar2(x,y,1,1))
316        ALLOCATE(tabvar3(x,y,1,1))
317        ALLOCATE(masksrc(x,y))
318        ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
319
320        !       
321        DO n = 1,nbvert_lev
322           !
323           WRITE(*,*) 'interpolate/extrapolate for vertical level = ',n   
324           !                           
325           CALL Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,1,n)
326           IF(n==1) THEN
327              !                           
328           ELSE IF (n==2) THEN
329              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
330           ELSE
331              tabvar3(:,:,:,1) = tabvar2(:,:,:,1)
332              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
333
334           ENDIF
335           !                           
336           SELECT CASE(posvar)
337              !
338           CASE('T')
339              !
340              IF(MAXVAL(G1%tmask(:,:,n)) == 0.) THEN           
341                 tabinterp4d = 0.0
342                 WRITE(*,*) 'only land points on level ',n                     
343              ELSE                       
344
345                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n)                                           
346
347                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n)                                 
348
349                 ! for the following variables, you do not want to mask the values
350                 IF(  TRIM(varname) == 'e3t_n' .OR. TRIM(varname) == 'e3t_b' .OR. TRIM(varname) == 'e3t_m' .OR. &
351                    & TRIM(varname) == 'fraqsr_1lev' .OR. TRIM(varname) == 'frq_m' .OR. TRIM(varname) == 'surf_ini' ) THEN
352                    masksrc(:,:) = .TRUE.
353                 ENDIF
354                 
355                 SELECT CASE(TRIM(interp_type))
356                 CASE('bilinear')                                                       
357                    CALL get_remap_matrix(G0%nav_lat,G1%nav_lat, &
358                       G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
359                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
360                       matrix,src_add,dst_add)     
361                 CASE('bicubic')                                   
362                    CALL get_remap_bicub(G0%nav_lat,G1%nav_lat, &
363                       G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
364                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
365                       nxfin,nyfin,matrix,src_add,dst_add) 
366                 END SELECT
367                 !
368                 IF( conservation ) THEN ! clem: it currently does not work
369                    CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
370                       G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
371                 ENDIF
372
373              ENDIF
374             
375              IF( ALL(masksrc) ) THEN
376                 tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1)
377              ELSE
378                 tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%tmask(:,:,n)
379              ENDIF
380              !
381           CASE('U')
382              !
383              IF(MAXVAL(G1%umask(:,:,n)) == 0) THEN
384                 tabinterp4d = 0.0
385                 WRITE(*,*) 'only land points on level ',n 
386              ELSE     
387                 !
388                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'U') 
389                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n,'U')
390                 !                                                           
391                 SELECT CASE(TRIM(interp_type))
392                 CASE('bilinear')                                                       
393                    CALL get_remap_matrix(G0%gphiu,G1%gphiu,   &
394                       G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
395                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
396                       matrix,src_add,dst_add)     
397                 CASE('bicubic')                                   
398                    CALL get_remap_bicub(G0%gphiu,G1%gphiu,   &
399                       G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
400                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
401                       nxfin,nyfin,matrix,src_add,dst_add)                       
402                 END SELECT
403                 !                     
404                 IF( conservation ) THEN ! clem: not coded for U
405                    CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
406                       G0%e1u,G0%e2u,G1%e1u,G1%e2u,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
407                 ENDIF
408              ENDIF
409
410              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%umask(:,:,n)
411              !
412           CASE('V')
413              !     
414              IF(MAXVAL(G1%vmask(:,:,n)) == 0) THEN
415                 tabinterp4d = 0.0
416                 WRITE(*,*) 'only land points on level ',n 
417              ELSE     
418                 !
419
420                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'V')
421
422                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n,'V')
423                 !                                                           
424                 SELECT CASE(TRIM(interp_type))
425                 CASE('bilinear')                                                       
426                    CALL get_remap_matrix(G0%gphiv,G1%gphiv,   &
427                       G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
428                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
429                       matrix,src_add,dst_add)     
430                 CASE('bicubic')                                   
431                    CALL get_remap_bicub(G0%gphiv,G1%gphiv,   &
432                       G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
433                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
434                       nxfin,nyfin,matrix,src_add,dst_add)                       
435                 END SELECT
436                 !                     
437                 IF( conservation ) THEN ! clem: not coded for V
438                    CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
439                       G0%e1v,G0%e2v,G1%e1v,G1%e2v,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
440                 ENDIF
441              ENDIF
442
443              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%vmask(:,:,n)
444              !
445           END SELECT
446           !
447           !
448           dimnames(1)='x'
449           dimnames(2)='y'
450           IF( vert_coord_name == '1' ) THEN
451              dimnames(3)=TRIM(timedimname)
452             
453              ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
454              tabvar3d=tabinterp4d(:,:,:,1)
455              CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabvar3d,1,'double')
456              DEALLOCATE(tabvar3d)
457           ELSE
458              dimnames(3)=vert_coord_name
459              dimnames(4)=TRIM(timedimname)
460             
461              CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabinterp4d,1,n,'double')
462           ENDIF
463           !             
464           !
465           CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_file),Child_file)
466           !
467           !
468           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
469           !
470        END DO
471        !
472        DEALLOCATE(detected_pts)
473        DEALLOCATE(tabinterp4d)
474        DEALLOCATE(tabvar1,tabvar2,tabvar3)
475        DEALLOCATE(masksrc) 
476        !                     
477     ENDIF
478
479  END DO
480
481  ! change the before fields
482  IF(rhot == 1) THEN
483     WRITE(*,*) ''   
484     WRITE(*,*) 'no time interpolation (time refinement ratio = 1)'
485  ELSE   
486     now_wght = (rhot-1.)/rhot
487     before_wght = 1./rhot
488     !   
489     ! --- 4D variables --- !               
490     CALL Read_Ncdf_var('un',Child_file,un)     
491     CALL Read_Ncdf_var('vn',Child_file,vn)
492     CALL Read_Ncdf_var('ub',Child_file,ub)
493     CALL Read_Ncdf_var('vb',Child_file,vb)
494     ub = now_wght*un + before_wght*ub
495     vb = now_wght*vn + before_wght*vb
496     !
497     CALL Read_Ncdf_var('tb',Child_file,tb)
498     CALL Read_Ncdf_var('tn',Child_file,tn)
499     tb = now_wght*tn + before_wght*tb
500     !
501     CALL Read_Ncdf_var('sb',Child_file,sb)
502     CALL Read_Ncdf_var('sn',Child_file,sn)           
503     sb = now_wght*sn + before_wght*sb
504     !
505     CALL Read_Ncdf_var('e3t_b',Child_file,e3t_b)
506     CALL Read_Ncdf_var('e3t_n',Child_file,e3t_n)           
507     e3t_b = now_wght*e3t_n + before_wght*e3t_b
508     !
509     dimnames(1)='x'
510     dimnames(2)='y'
511     dimnames(3)='nav_lev'
512     dimnames(4)=TRIM(timedimname)
513     CALL Write_Ncdf_var('ub',dimnames,Child_file,ub,'double')
514     CALL Write_Ncdf_var('vb',dimnames,Child_file,vb,'double')
515     CALL Write_Ncdf_var('tb',dimnames,Child_file,tb,'double')
516     CALL Write_Ncdf_var('sb',dimnames,Child_file,sb,'double')
517     CALL Write_Ncdf_var('e3t_b',dimnames,Child_file,e3t_b,'double')
518     !
519     DEALLOCATE(un,ub,vn,vb,tn,tb,sn,sb,e3t_n,e3t_b)
520     !----------------------               
521     !
522     ! --- 3D variables --- !       
523     CALL Read_Ncdf_var('sshb',Child_file,sshb)
524     CALL Read_Ncdf_var('sshn',Child_file,sshn)
525     sshb = now_wght*sshn + before_wght*sshb
526     !
527     dimnames(1)='x'
528     dimnames(2)='y'
529     dimnames(3)=TRIM(timedimname)
530     CALL Write_Ncdf_var('sshb',dimnames,Child_file,sshb,'double')
531     !               
532     DEALLOCATE(sshn,sshb) 
533     !----------------------               
534     !   
535  ENDIF
536  !
537  !
538  WRITE(*,*) ' '
539  WRITE(*,*) ' --- list of all the variables that have been interpolated --- '
540  WRITE(*,*) Ncdf_varname
541  WRITE(*,*) ' '
542  WRITE(*,*) '******* restart file successfully created *******' 
543  WRITE(*,*) ' '
544  !
545  STOP
546END PROGRAM
547
548
Note: See TracBrowser for help on using the repository browser.