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

source: utils/tools/NESTING/src/agrif_create_data.f90 @ 12253

Last change on this file since 12253 was 10381, checked in by clem, 5 years ago

attempt to correct several bugs in the NESTING tools. With this version, domcfg.nc file should be written correctly and the partial steps should be taken into account.

  • Property svn:keywords set to Id
File size: 1.8 KB
Line 
1PROGRAM create_data
2  !
3  USE io_netcdf
4  USE bilinear_interp
5  USE agrif_readwrite
6  USE agrif_interpolation     
7  !
8  IMPLICIT NONE
9  !
10  !************************************************************************
11  !                           *
12  ! PROGRAM  CREATE_DATA                       *
13  !                           *
14  ! program to implement data interpolation to generate        *
15  ! child grid forcing files                 *
16  !                           *
17  !Interpolation is carried out using bilinear interpolation      *
18  !routine from SCRIP package                *     
19  !                           *
20  !http://climate.lanl.gov/Software/SCRIP/            *
21  !************************************************************************
22  !
23  INTEGER           :: narg, iargc, ji
24  CHARACTER(len=80) :: namelistname
25
26  narg = iargc()
27
28  IF (narg == 0) THEN
29     namelistname = 'namelist.input'
30  ELSE
31     CALL getarg(1,namelistname)
32  ENDIF
33
34  ! read input file (namelist.input)
35  CALL read_namelist(namelistname)
36  !
37  ! Interpolate U grid  data
38  ji = 1
39  DO WHILE( TRIM(U_Files(ji)) /= '' )
40     PRINT *,'Grid U forcing files = ',u_files(ji)
41     !       
42     CALL Interp_Extrap_var(U_FILES(ji), 'U') 
43     ji = ji+1               
44     !             
45  END DO
46
47  !
48  ! Interpolate V grid  data
49  ji = 1
50  DO WHILE( TRIM(V_Files(ji)) /= '' )
51     PRINT *,'Grid V forcing files = ',v_files(ji)
52     !       
53     CALL Interp_Extrap_var(V_FILES(ji), 'V') 
54     ji = ji+1               
55     !             
56  END DO
57  !
58  ! Interpolate flux data
59  ji = 1
60  DO WHILE( TRIM(Flx_Files(ji)) /= '' )
61     PRINT *,'flxfiles = ',flx_files(ji)
62     !       
63     CALL Interp_Extrap_var(FLX_FILES(ji), 'T') 
64     ji = ji+1               
65     !             
66  END DO
67  !
68  WRITE(*,*) ' '
69  WRITE(*,*) '******* forcing files successfully created *******' 
70  WRITE(*,*) ' ' 
71  !
72  STOP
73END PROGRAM create_data
Note: See TracBrowser for help on using the repository browser.