Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
No results found
Show changes
Hide whitespace changes
Inline Side-by-side
tools/NESTING/src/agrif_create_restart.f90
View file @ 4a9f4b18
......@@ -99,7 +99,7 @@ PROGRAM create_rstrt
! create this file
!
CALL set_child_name(restart_file,Child_file)
status = nf90_create(Child_file,NF90_WRITE,ncid)
status = nf90_create(Child_file,NF90_NETCDF4,ncid)
status = nf90_close(ncid)
WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)
WRITE(*,*) ''
......
tools/NESTING/src/agrif_interpolation.f90
View file @ 4a9f4b18
......@@ -210,21 +210,21 @@ CONTAINS
SELECT CASE(typevar)
CASE('T')
IF(MOD(irafx,2)==1) THEN ! odd
zx = 1 ; zy = 1 ; jdecx = FLOOR(irafx/2.) ; jdecy = FLOOR(irafy/2.)
zx = 1 ; zy = 1 ; jdecx = FLOOR(REAL(irafx)/2.) ; jdecy = FLOOR(REAL(irafy)/2.)
ELSE ! even
zx = 2 ; zy = 2 ; jdecx = FLOOR(irafx/2.) ; jdecy = FLOOR(irafy/2.)
zx = 2 ; zy = 2 ; jdecx = FLOOR(REAL(irafx)/2.) ; jdecy = FLOOR(REAL(irafy)/2.)
ENDIF
CASE('U')
IF(MOD(irafx,2)==1) THEN ! odd
zx = 1 ; zy = 1 ; jdecx = irafx - 1 ; jdecy = FLOOR(irafy/2.)
zx = 1 ; zy = 1 ; jdecx = irafx - 1 ; jdecy = FLOOR(REAL(irafy)/2.)
ELSE ! even
zx = 1 ; zy = 2 ; jdecx = irafx - 1 ; jdecy = FLOOR(irafy/2.)
zx = 1 ; zy = 2 ; jdecx = irafx - 1 ; jdecy = FLOOR(REAL(irafy)/2.)
ENDIF
CASE('V')
IF(MOD(irafx,2)==1) THEN ! odd
zx = 1 ; zy = 1 ; jdecx = FLOOR(irafx/2.) ; jdecy = irafy - 1
zx = 1 ; zy = 1 ; jdecx = FLOOR(REAL(irafx)/2.) ; jdecy = irafy - 1
ELSE ! even
zx = 2 ; zy = 1 ; jdecx = FLOOR(irafx/2.) ; jdecy = irafy - 1
zx = 2 ; zy = 1 ; jdecx = FLOOR(REAL(irafx)/2.) ; jdecy = irafy - 1
ENDIF
CASE('F')
IF(MOD(irafx,2)==1) THEN ! odd
......@@ -238,21 +238,24 @@ CONTAINS
DO jj = 1, nyf
jjf = jj - jdecy
jjc = j_min + FLOOR((jjf-1.) / irafy)
jjc = j_min + FLOOR(REAL(jjf-1) / REAL(irafy))
DO ji = 1, nxf
jif = ji - jdecx
jic = i_min + FLOOR((jif-1.) / irafx)
Bx = MOD( zx*jif-1, zx*irafx ) / REAL(zx*irafx)
By = MOD( zy*jjf-1, zy*irafy ) / REAL(zy*irafy)
jic = i_min + FLOOR(REAL(jif-1) / REAL(irafx))
Bx = REAL(MODULO( zx*jif-1, zx*irafx )) / REAL(zx*irafx)
By = REAL(MODULO( zy*jjf-1, zy*irafy )) / REAL(zy*irafy)
Ax = 1. - Bx
Ay = 1. - By
jic1 = MIN( nxc, jic+1 ) ! avoid out of bounds for tabin below
jjc1 = MIN( nyc, jjc+1 ) ! --
jic = MAX( 1, jic ) ! avoid out of bounds
jjc = MAX( 1, jjc ) ! avoid out of bounds
tabout(ji,jj) = ( Bx * tabin(jic1,jjc ) + Ax * tabin(jic,jjc ) ) * Ay + &
& ( Bx * tabin(jic1,jjc1) + Ax * tabin(jic,jjc1) ) * By
END DO
......@@ -503,7 +506,7 @@ CONTAINS
REAL*8, POINTER, DIMENSION(:,:) :: lonParent,latParent => NULL()
REAL*8, POINTER, DIMENSION(:,:) :: lonChild,latChild,latlon_temp => NULL()
REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
REAL*8, POINTER, DIMENSION(:,:,:) :: tabinterp3d,tabvar3d => NULL()
REAL*8, POINTER, DIMENSION(:,:,:) :: tabinterp3d,tabvar3d,tabvar01,tabvar02,tabvar03 => NULL()
REAL*8, POINTER, DIMENSION(:) :: timedepth_temp,depth => NULL()
REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
INTEGER,DIMENSION(:),POINTER :: src_add,dst_add => NULL()
......@@ -515,11 +518,17 @@ CONTAINS
LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
LOGICAL :: Interpolation,conservation,Pacifique,Extrapolation,land_level
!
INTEGER :: deptht,time,i,status,ncid,t,ii,j,nb,numlon,numlat
INTEGER :: deptht,time,i,status,ncid,t,ii,j,nb,numlon,numlat,unlimdimid
!
TYPE(Coordinates) :: G0,G1
!
status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
IF (status/=nf90_noerr) THEN
WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
STOP
ENDIF
!
!*****************
!If coarse grid is masked possibility to activate an extrapolation process
!
......@@ -541,7 +550,6 @@ CONTAINS
!
CALL Read_Ncdf_dim('x',filename,numlon)
CALL Read_Ncdf_dim('y',filename,numlat)
CALL Read_Ncdf_dim('time_counter',filename,time)
IF ( Dims_Existence( 'deptht' , filename ) ) THEN
CALL Read_Ncdf_dim('deptht',filename,deptht)
ELSE IF ( Dims_Existence( 'depthu' , filename ) ) THEN
......@@ -555,7 +563,28 @@ CONTAINS
ELSE
deptht = N
ENDIF
IF ( Dims_Existence( 'time_counter' , filename ) ) THEN
CALL Read_Ncdf_dim('time_counter',filename,time)
! check that time_counter is the unlimited dim
status = nf90_inquire(ncid, unlimiteddimid = unlimdimid)
IF ( unlimdimid == -1 ) THEN
WRITE(*,*)"time_counter should be the unlimited dimension in this file : ",filename
WRITE(*,*)" use nco command: ncks -O --mk_rec_dmn time_counter ",filename," ",filename
STOP
ENDIF
ELSEIF( Dims_Existence( 'time' , filename ) ) THEN
CALL Read_Ncdf_dim('time',filename,time)
! check that time is the unlimited dim
status = nf90_inquire(ncid, unlimiteddimid = unlimdimid)
IF ( unlimdimid == -1 ) THEN
WRITE(*,*)"time should be the unlimited dimension in this file : ",filename
WRITE(*,*)" use nco command: ncks -O --mk_rec_dmn time ",filename," ",filename
STOP
ENDIF
ELSE
time = 0
ENDIF
!
! retrieve netcdf variable name
!
......@@ -579,7 +608,7 @@ CONTAINS
status = Read_Coordinates(Childcoordinates,G1,Pacifique)
!
! check consistency of informations read in namelist
!
!
IF( imax > SIZE(G0%glamt,1) .OR. jmax > SIZE(G0%glamt,2) .OR. &
imax <= imin .OR. jmax <= jmin ) THEN
WRITE(*,*) 'ERROR ***** bad child grid definition ...'
......@@ -597,7 +626,6 @@ CONTAINS
STOP
ENDIF
!
!
! Initialization of T-mask thanks to bathymetry
!
......@@ -610,7 +638,6 @@ CONTAINS
CALL Init_mask(parent_bathy_level,G0,1,1)
!
ENDIF
!
! select coordinates to use according to variable position
!
......@@ -619,23 +646,67 @@ CONTAINS
SELECT CASE(posvar)
CASE('T')
lonParent = G0%glamt
latParent = G0%gphit
lonChild = G1%glamt
latChild = G1%gphit
mask = G1%tmask
IF ( Vars_Existence( 'glamt' , parent_coordinate_file ) ) THEN
lonParent = G0%glamt
latParent = G0%gphit
ELSEIF( Vars_Existence( 'nav_lon' , parent_coordinate_file ) ) THEN
lonParent = G0%nav_lon
latParent = G0%nav_lat
ENDIF
IF ( Vars_Existence( 'glamt' , Childcoordinates ) ) THEN
lonChild = G1%glamt
latChild = G1%gphit
ELSEIF( Vars_Existence( 'nav_lon' , Childcoordinates ) ) THEN
lonChild = G1%nav_lon
latChild = G1%nav_lat
ENDIF
!!IF ( Vars_Existence( 'tmask' , Childcoordinates ) ) THEN
mask = G1%tmask
!!ELSEIF( Vars_Existence( 'top_level' , Childcoordinates ) ) THEN
!! mask = MAX( 1., G1%top_level )
!!ELSE
!! mask = 1.
!!ENDIF
CASE('U')
lonParent = G0%glamu
latParent = G0%gphiu
lonChild = G1%glamu
latChild = G1%gphiu
mask = G1%umask
IF ( Vars_Existence( 'glamu' , parent_coordinate_file ) ) THEN
lonParent = G0%glamu
latParent = G0%gphiu
ELSE
WRITE(*,*) 'ERROR ***** missing glamu/gphiu coordinates in ', TRIM(parent_coordinate_file)
STOP
ENDIF
IF ( Vars_Existence( 'glamu' , Childcoordinates ) ) THEN
lonChild = G1%glamu
latChild = G1%gphiu
ELSE
WRITE(*,*) 'ERROR ***** missing glamu/gphiu coordinates in ', TRIM(Childcoordinates)
STOP
ENDIF
!!IF ( Vars_Existence( 'umask' , Childcoordinates ) ) THEN
mask = G1%umask
!!ELSE
!! mask = 1.
!!ENDIF
CASE('V')
lonParent = G0%glamv
latParent = G0%gphiv
lonChild = G1%glamv
latChild = G1%gphiv
mask = G1%vmask
IF ( Vars_Existence( 'glamv' , parent_coordinate_file ) ) THEN
lonParent = G0%glamv
latParent = G0%gphiv
ELSE
WRITE(*,*) 'ERROR ***** missing glamv/gphiv coordinates in ', TRIM(parent_coordinate_file)
STOP
ENDIF
IF ( Vars_Existence( 'glamv' , Childcoordinates ) ) THEN
lonChild = G1%glamv
latChild = G1%gphiv
ELSE
WRITE(*,*) 'ERROR ***** missing glamv/gphiv coordinates in ', TRIM(Childcoordinates)
STOP
ENDIF
!!IF ( Vars_Existence( 'vmask' , Childcoordinates ) ) THEN
mask = G1%vmask
!!ELSE
!! mask = 1.
!!ENDIF
END SELECT
DEALLOCATE(G0%glamu,G0%glamv,G0%gphiu,G0%gphiv)
......@@ -665,8 +736,9 @@ CONTAINS
IF ( Dims_Existence( 'depthu' , filename ) ) CALL Write_Ncdf_dim('depthu',Child_file,deptht)
IF ( Dims_Existence( 'depthv' , filename ) ) CALL Write_Ncdf_dim('depthv',Child_file,deptht)
IF ( Dims_Existence( 'depthw' , filename ) ) CALL Write_Ncdf_dim('depthw',Child_file,deptht)
IF ( Dims_Existence( 'z' , filename ) ) CALL Write_Ncdf_dim('z',Child_file,deptht)
CALL Write_Ncdf_dim('time_counter',Child_file,0)
IF ( Dims_Existence( 'z' , filename ) ) CALL Write_Ncdf_dim('z' ,Child_file,deptht)
IF ( Dims_Existence( 'time_counter' , filename ) ) CALL Write_Ncdf_dim('time_counter',Child_file,time)
IF ( Dims_Existence( 'time' , filename ) ) CALL Write_Ncdf_dim('time' ,Child_file,time)
IF( deptht .NE. 1 .AND. deptht .NE. N ) THEN
WRITE(*,*) '***'
......@@ -733,6 +805,17 @@ CONTAINS
varname = TRIM(Ncdf_varname(i))
Interpolation = .FALSE.
!
!copy time from input file to output file
CASE('time')
ALLOCATE(timedepth_temp(time))
CALL Read_Ncdf_var('time',filename,timedepth_temp)
CALL Write_Ncdf_var('time','time', &
Child_file,timedepth_temp,'float')
CALL Copy_Ncdf_att('time',TRIM(filename),Child_file)
DEALLOCATE(timedepth_temp)
varname = TRIM(Ncdf_varname(i))
Interpolation = .FALSE.
!
!copy deptht from input file to output file
CASE('deptht')
ALLOCATE(depth(deptht))
......@@ -806,84 +889,305 @@ CONTAINS
!
END SELECT
! //////////////// INTERPOLATION FOR 3D VARIABLES /////////////////////////////////////
! //////////////// INTERPOLATION FOR 2D VARIABLES /////////////////////////////////////
!
IF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 3 ) THEN
IF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 2 ) THEN
!
ALLOCATE(detected_pts(numlon,numlat,N))
ALLOCATE(masksrc(numlon,numlat))
!
! ******************************LOOP ON TIME*******************************************
!loop on time
DO t = 1,time
!
IF(extrapolation) THEN
WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for time t = ',t
ELSE
WRITE(*,*) 'interpolation ',TRIM(varname),' for time t = ',t
ENDIF
!
ALLOCATE(tabvar3d(numlon,numlat,1))
ALLOCATE(tabinterp3d(nxfin,nyfin,1))
!
CALL Read_Ncdf_var(varname,filename,tabvar3d,t)
IF(extrapolation) THEN
WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname)
ELSE
WRITE(*,*) 'interpolation ',TRIM(varname)
ENDIF
!
ALLOCATE(tabvar3d(numlon,numlat,1))
ALLOCATE(tabinterp3d(nxfin,nyfin,1))
!
CALL Read_Ncdf_var(varname,filename,tabvar3d)
!
! search points where extrapolation is required
!
IF(Extrapolation) THEN
WHERE( tabvar3d .GE. 1.e+20 ) tabvar3d = 0.
CALL extrap_detect(G0,G1,detected_pts(:,:,1),1)
CALL correct_field_2d(detected_pts(:,:,1),tabvar3d,G0,masksrc,'posvar')
ELSE
masksrc = .TRUE.
ENDIF
SELECT CASE(TRIM(interp_type))
CASE('bilinear')
CALL get_remap_matrix(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
CASE('bicubic')
CALL get_remap_bicub(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
END SELECT
!
!
SELECT CASE(TRIM(interp_type))
CASE('bilinear')
CALL make_remap(tabvar3d(:,:,1),tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
CASE('bicubic')
CALL make_bicubic_remap(tabvar3d(:,:,1),masksrc,tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
END SELECT
!
IF( conservation ) CALL Correctforconservation(tabvar3d(:,:,1),tabinterp3d(:,:,1), &
G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)
!
IF(Extrapolation) tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)
!! tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)
!
dimnames(1)='x'
dimnames(2)='y'
!
CALL Write_Ncdf_var(TRIM(varname),dimnames(1:2),&
Child_file,tabinterp3d(:,:,1),'float')
!
DEALLOCATE(tabinterp3d)
DEALLOCATE(tabvar3d)
!
DEALLOCATE(detected_pts)
IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
DEALLOCATE( masksrc)
CALL Copy_Ncdf_att(TRIM(varname),TRIM(filename),Child_file)
!
! //////////////// INTERPOLATION FOR 3D VARIABLES /////////////////////////////////////
!
ELSEIF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 3 ) THEN
!
IF( DimUnlimited_Var(TRIM(varname),TRIM(filename)) ) THEN
ALLOCATE(detected_pts(numlon,numlat,N))
ALLOCATE(masksrc(numlon,numlat))
!
! search points where extrapolation is required
!
IF(Extrapolation) THEN
WHERE( tabvar3d .GE. 1.e+20 ) tabvar3d = 0.
IF (t .EQ. 1. ) CALL extrap_detect(G0,G1,detected_pts(:,:,1),1)
CALL correct_field_2d(detected_pts(:,:,1),tabvar3d,G0,masksrc,'posvar')
ELSE
masksrc = .TRUE.
ENDIF
! ******************************LOOP ON TIME*******************************************
!loop on time
DO t = 1,time
!
IF(extrapolation) THEN
WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for time t = ',t
ELSE
WRITE(*,*) 'interpolation ',TRIM(varname),' for time t = ',t
ENDIF
!
ALLOCATE(tabvar3d(numlon,numlat,1))
ALLOCATE(tabinterp3d(nxfin,nyfin,1))
!
CALL Read_Ncdf_var(varname,filename,tabvar3d,t)
!
! search points where extrapolation is required
!
IF(Extrapolation) THEN
WHERE( tabvar3d .GE. 1.e+20 ) tabvar3d = 0.
IF (t .EQ. 1. ) CALL extrap_detect(G0,G1,detected_pts(:,:,1),1)
CALL correct_field_2d(detected_pts(:,:,1),tabvar3d,G0,masksrc,'posvar')
ELSE
masksrc = .TRUE.
ENDIF
IF (t.EQ.1 ) THEN
IF (t.EQ.1 ) THEN
SELECT CASE(TRIM(interp_type))
CASE('bilinear')
CALL get_remap_matrix(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
CASE('bicubic')
CALL get_remap_bicub(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
END SELECT
!
ENDIF
!
SELECT CASE(TRIM(interp_type))
CASE('bilinear')
CALL get_remap_matrix(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
CASE('bilinear')
CALL make_remap(tabvar3d(:,:,1),tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
CASE('bicubic')
CALL make_bicubic_remap(tabvar3d(:,:,1),masksrc,tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
END SELECT
!
IF( conservation ) CALL Correctforconservation(tabvar3d(:,:,1),tabinterp3d(:,:,1), &
G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)
!
IF(Extrapolation) tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)
!! tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)
!
dimnames(1)='x'
dimnames(2)='y'
dimnames(3)='time_counter'
!
CALL Write_Ncdf_var(TRIM(varname),dimnames(1:3),&
Child_file,tabinterp3d,t,'float')
!
DEALLOCATE(tabinterp3d)
DEALLOCATE(tabvar3d)
!end loop on time
END DO
!
DEALLOCATE(detected_pts)
IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
DEALLOCATE( masksrc)
CASE('bicubic')
CALL get_remap_bicub(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
ELSE
END SELECT
!
ENDIF
!
SELECT CASE(TRIM(interp_type))
CASE('bilinear')
CALL make_remap(tabvar3d(:,:,1),tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
CASE('bicubic')
CALL make_bicubic_remap(tabvar3d(:,:,1),masksrc,tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
END SELECT
!
IF( conservation ) CALL Correctforconservation(tabvar3d(:,:,1),tabinterp3d(:,:,1), &
G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)
!
IF(Extrapolation) tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)
!
dimnames(1)='x'
dimnames(2)='y'
dimnames(3)='time_counter'
!
CALL Write_Ncdf_var(TRIM(varname),dimnames(1:3),&
Child_file,tabinterp3d,t,'float')
!
DEALLOCATE(tabinterp3d)
DEALLOCATE(tabvar3d)
!end loop on time
END DO
!
DEALLOCATE(detected_pts)
IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
DEALLOCATE( masksrc)
IF ( Dims_Existence( 'deptht' , filename ) ) dimnames(3)='deptht'
IF ( Dims_Existence( 'depthu' , filename ) ) dimnames(3)='depthu'
IF ( Dims_Existence( 'depthv' , filename ) ) dimnames(3)='depthv'
IF ( Dims_Existence( 'depthw' , filename ) ) dimnames(3)='depthw'
IF ( Dims_Existence( 'z' , filename ) ) dimnames(3)='z'
!
! loop on vertical levels
!
DO nb = 1,deptht
!
ALLOCATE(masksrc(numlon,numlat))
ALLOCATE(detected_pts(numlon,numlat,N))
!
! point detection et level n
!
land_level = .FALSE.
IF( Extrapolation ) THEN
IF(MAXVAL(mask(:,:,nb))==0.) land_level = .TRUE.
ENDIF
IF ( land_level ) THEN
!
WRITE(*,*) 'only land points on level ',nb
ALLOCATE(tabinterp3d(nxfin,nyfin,1))
tabinterp3d = 0.e0
!
CALL Write_Ncdf_var(TRIM(varname),dimnames, &
Child_file,tabinterp3d,nb,'float')
DEALLOCATE(tabinterp3d)
!
ELSE
!
ALLOCATE(tabvar01(numlon,numlat,1)) ! level k
IF(Extrapolation) ALLOCATE(tabvar02(numlon,numlat,1)) ! level k-1
IF(Extrapolation) ALLOCATE(tabvar03(numlon,numlat,1)) ! level k-2
ALLOCATE(tabinterp3d(nxfin,nyfin,1))
!
IF(Extrapolation) THEN
IF(nb==1) THEN
CALL Read_Ncdf_var(varname,filename,tabvar01,nb)
WHERE( tabvar01 .GE. 1.e+20 ) tabvar01 = 0.
ELSE IF (nb==2) THEN
CALL Read_Ncdf_var(varname,filename,tabvar02,nb-1)
CALL Read_Ncdf_var(varname,filename,tabvar01,nb)
WHERE( tabvar01 .GE. 1.e+20 ) tabvar01 = 0.
WHERE( tabvar02 .GE. 1.e+20 ) tabvar02 = 0.
ELSE
CALL Read_Ncdf_var(varname,filename,tabvar03,nb-2)
CALL Read_Ncdf_var(varname,filename,tabvar02,nb-1)
CALL Read_Ncdf_var(varname,filename,tabvar01,nb)
WHERE( tabvar01 .GE. 1.e+20 ) tabvar01 = 0.
WHERE( tabvar02 .GE. 1.e+20 ) tabvar02 = 0.
WHERE( tabvar03 .GE. 1.e+20 ) tabvar03 = 0.
ENDIF
!
CALL extrap_detect(G0,G1,detected_pts(:,:,nb),nb)
ALLOCATE(tabvar1(numlon,numlat,1,1)) ! level k
ALLOCATE(tabvar2(numlon,numlat,1,1)) ! level k-1
ALLOCATE(tabvar3(numlon,numlat,1,1)) ! level k-2
tabvar1(:,:,1,1) = tabvar01(:,:,1)
tabvar2(:,:,1,1) = tabvar02(:,:,1)
tabvar3(:,:,1,1) = tabvar03(:,:,1)
CALL correct_field(detected_pts(:,:,nb),tabvar1,tabvar2,&
tabvar3,G0,depth,masksrc,nb,'posvar')
tabvar01(:,:,1) = tabvar1(:,:,1,1)
tabvar02(:,:,1) = tabvar2(:,:,1,1)
tabvar03(:,:,1) = tabvar3(:,:,1,1)
DEALLOCATE(tabvar1,tabvar2,tabvar3)
DEALLOCATE(tabvar02,tabvar03)
ELSE
CALL Read_Ncdf_var(varname,filename,tabvar01,nb)
IF(MAXVAL(tabvar01(:,:,1))==0.) land_level = .TRUE.
masksrc = .TRUE.
ENDIF
IF( Extrapolation ) THEN
WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for vertical level = ',nb
ELSE
WRITE(*,*) 'interpolation ',TRIM(varname),' for vertical level = ',nb
ENDIF
!
SELECT CASE(TRIM(interp_type))
CASE('bilinear')
CALL get_remap_matrix(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
CASE('bicubic')
CALL get_remap_bicub(latParent,latChild, &
lonParent,lonChild, &
masksrc,matrix,src_add,dst_add)
!
END SELECT
!
!
SELECT CASE(TRIM(interp_type))
!
CASE('bilinear')
CALL make_remap(tabvar01(:,:,1),tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
CASE('bicubic')
CALL make_bicubic_remap(tabvar01(:,:,1),masksrc,tabinterp3d(:,:,1),nxfin,nyfin, &
matrix,src_add,dst_add)
END SELECT
!
IF( conservation ) CALL Correctforconservation(tabvar01(:,:,1),tabinterp3d(:,:,1), &
G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)
!
ALLOCATE(tabinterp4d(nxfin,nyfin,1,1))
tabinterp4d(:,:,1,1) = tabinterp3d(:,:,1)
IF(Extrapolation) CALL check_extrap(G1,tabinterp4d,nb)
tabinterp3d(:,:,1) = tabinterp4d(:,:,1,1)
DEALLOCATE(tabinterp4d)
!
IF(Extrapolation) tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,nb)
!! tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,nb)
!
CALL Write_Ncdf_var(TRIM(varname),dimnames, &
Child_file,tabinterp3d,nb,'float')
!
DEALLOCATE(tabinterp3d)
DEALLOCATE(tabvar01)
!
!
ENDIF
!
IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
DEALLOCATE( masksrc )
DEALLOCATE(detected_pts)
!
! end loop on vertical levels
!
END DO
ENDIF
CALL Copy_Ncdf_att(TRIM(varname),TRIM(filename),Child_file)
!
......
tools/NESTING/src/agrif_readwrite.f90
View file @ 4a9f4b18
......@@ -1128,7 +1128,7 @@ CONTAINS
USE io_netcdf
!
CHARACTER(*) name
INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo,ji,jj
TYPE(Coordinates) :: Grid
REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
!
......@@ -1145,7 +1145,6 @@ CONTAINS
nx = SIZE(Grid%Bathy_level,1)
ny = SIZE(Grid%Bathy_level,2)
!
!
ALLOCATE(Grid%tmask(nx,ny,N), &
Grid%umask(nx,ny,N), &
Grid%vmask(nx,ny,N), &
......@@ -1154,21 +1153,34 @@ CONTAINS
DO k = 1,N
!
WHERE(Grid%Bathy_level(:,:) <= k-1 )
Grid%tmask(:,:,k) = 0
Grid%tmask(:,:,k) = 0.
ELSEWHERE
Grid%tmask(:,:,k) = 1
Grid%tmask(:,:,k) = 1.
END WHERE
!
END DO
!
Grid%umask(1:nx-1,:,:) = Grid%tmask(1:nx-1,:,:)*Grid%tmask(2:nx,:,:)
Grid%vmask(:,1:ny-1,:) = Grid%tmask(:,1:ny-1,:)*Grid%tmask(:,2:ny,:)
DO jj=1,ny
DO ji=1,nx-1
Grid%umask(ji,jj,:) = Grid%tmask(ji,jj,:) * Grid%tmask(ji+1,jj,:)
ENDDO
ENDDO
DO jj=1,ny-1
DO ji=1,nx
Grid%vmask(ji,jj,:) = Grid%tmask(ji,jj,:)*Grid%tmask(ji,jj+1,:)
ENDDO
ENDDO
!
Grid%umask(nx,:,:) = Grid%tmask(nx,:,:)
Grid%vmask(:,ny,:) = Grid%tmask(:,ny,:)
!
Grid%fmask(1:nx-1,1:ny-1,:) = Grid%tmask(1:nx-1,1:ny-1,:)*Grid%tmask(2:nx,1:ny-1,:)* &
Grid%tmask(1:nx-1,2:ny,:)*Grid%tmask(2:nx,2:ny,:)
!
DO jj=1,ny-1
DO ji=1,nx-1
Grid%fmask(ji,jj,:) = Grid%tmask(ji,jj,:)*Grid%tmask(ji+1,jj,:)* &
Grid%tmask(ji,jj+1,:)*Grid%tmask(ji+1,jj+1,:)
ENDDO
ENDDO
!
Grid%fmask(nx,:,:) = Grid%tmask(nx,:,:)
Grid%fmask(:,ny,:) = Grid%tmask(:,ny,:)
......@@ -1233,6 +1245,8 @@ CONTAINS
nx = SIZE(Grid%Bathy_level,1)
ny = SIZE(Grid%Bathy_level,2)
!
WRITE(*,*) 'nx=',nx,' ny=',ny
!
WRITE(*,*) 'Init masks in T points'
!
ALLOCATE( Grid%tmask(nx,ny,N) )
......
tools/NESTING/src/bilinear_interp.f90
View file @ 4a9f4b18
......@@ -205,7 +205,6 @@ CONTAINS
ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
CALL logtab2Dto1D(mask,grid1_mask)
!
! Write(*,*) ,'grid1_mask = ',grid1_mask
!
! degrees to radian
!
......@@ -529,6 +528,7 @@ CONTAINS
! bilinear weights for four corners
!
REAL*8, DIMENSION(4) :: wgts
INTEGER, DIMENSION(1) :: wmax !!clem nearest
!
REAL*8 :: &
plat, plon, & ! lat/lon coords of destination point
......@@ -653,6 +653,11 @@ CONTAINS
wgts(3) = iguess*jguess
wgts(4) = (one-iguess)*jguess
!
!!clem nearest
!wmax=MAX( 1, MAXLOC( wgts(1:4), MASK = (grid1_mask(src_add(1:4)) == .TRUE.) ) )
!wgts(1:4)=0.
!wgts(wmax)=1.
!!clem
!
CALL store_link_bilin(dst_add, src_add, wgts, nmap)
......@@ -669,7 +674,7 @@ CONTAINS
!*** search for bilinear failed - use a distance-weighted
!*** average instead (this is typically near the pole)
!***
ELSE IF (src_add(1) < 0) THEN
ELSE IF (src_add(1) <= 0) THEN
src_add = ABS(src_add)
icount = 0
......@@ -693,6 +698,11 @@ CONTAINS
wgts(3) = src_lats(3)/sum_wgts
wgts(4) = src_lats(4)/sum_wgts
!
!!clem nearest
!wmax=MAX( 1, MAXLOC( wgts(1:4), MASK = (grid1_mask(src_add(1:4)) == .TRUE.) ) )
!wgts(1:4)=0.
!wgts(wmax)=1.
!!clem
grid2_frac(dst_add) = one
CALL store_link_bilin(dst_add, src_add, wgts, nmap)
ENDIF
......
tools/NESTING/src/io_netcdf.f90
View file @ 4a9f4b18
......@@ -1603,4 +1603,53 @@ CONTAINS
!
END FUNCTION Dims_Existence
!
LOGICAL FUNCTION Vars_Existence( varname , filename )
!
CHARACTER(*),INTENT(in) :: varname,filename
INTEGER :: status,ncid,varid
!
status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
IF (status/=nf90_noerr) THEN
WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
STOP
ENDIF
status = nf90_inq_varid(ncid,TRIM(varname),varid)
!
IF (status/=nf90_noerr) THEN
Vars_Existence = .FALSE.
ELSE
Vars_Existence = .TRUE.
ENDIF
!
RETURN
!
END FUNCTION Vars_Existence
!
LOGICAL FUNCTION DimUnlimited_Var( varname , filename )
!
CHARACTER(*),INTENT(in) :: varname,filename
INTEGER :: ji, ncid, varid, status, numDims, unlimDimID
INTEGER, DIMENSION(nf90_max_var_dims) :: VarDimIds
!
status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
IF (status/=nf90_noerr) THEN
WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
STOP
ENDIF
status = nf90_inquire(ncid, unlimiteddimid = unlimdimid)
!
status = nf90_inq_varid(ncid,TRIM(varname),varid)
!
status = nf90_inquire_variable(ncid, varid , ndims = numdims)
status = nf90_inquire_variable(ncid, varid , dimids = vardimids(:numdims))
DimUnlimited_Var = .FALSE.
DO ji = 1, numdims
IF( vardimids(ji) == unlimdimid ) DimUnlimited_Var = .TRUE.
ENDDO
RETURN
!
END FUNCTION DimUnlimited_Var
END MODULE io_netcdf
tools/README.rst deleted 100644 → 0
View file @ 266206a5
*****
Tools
*****
.. todo::
The 'Tools' chapter needs to be enriched
.. contents::
:local:
:depth: 1
A set of tools is provided with NEMO to setup user own configuration and (pre|post)process data.
How to compile a tool
=====================
The tool can be compiled using the maketools script in the tools directory as follows:
.. code-block:: console
$ ./maketools -m 'my_arch' -n '<TOOL_NAME>'
where ``my_arch`` can be selected among available architecture files or providing a user defined one.
List of tools
=============
BDY_TOOLS
---------
It contains the utility *bdy_reorder* used to reorder old BDY data files used with
previous versions of the model (before 3.4) to make them compatible with NEMO 3.4.
DMP_TOOLS
---------
Used to create a netcdf file called :file:`resto.nc` containing
restoration coefficients for use with the :file:`tra_dmp` module in NEMO
(see :download:`DMP_TOOLS README <../../../tools/DMP_TOOLS/README>`).
DOMAINcfg
---------
A toolbox allowing the creation of regional configurations from curvilinear grid
(see :download:`DOMAINcfg README <../../../tools/DOMAINcfg/README.rst>`).
GRIDGEN
-------
This tool allows the creation of a domain configuration file (``domain_cfg.nc``) containing
the ocean domain information required to define an ocean configuration from scratch.
(see :download:`GRIDGEN documentation <../../../tools/GRIDGEN/doc_cfg_tools.pdf>`).
MISCELLANEOUS
-------------
The tool allows to create alternative configurations to the community without
having to rely on system team sponsorship and support.
MPP_PREP
--------
This tool provides the user with information to choose the best domain decomposition.
The tool computes the number of water processors for all possible decompositions,
up to a maximum number of processors
(see :download:`MPP_PREP documentation <../../../tools/MPP_PREP/mpp_nc.pdf>` and
:download:`MPP_PREP archive <../../../tools/MPP_PREP/mpp_prep-1.0.tar.gz>`).
NESTING
-------
AGRIF nesting tool allows for the seamless two-way coupling of nested sub-models within
the NEMO framework as long as these are defined on subsets of the original root grid.
It allows to create the grid coordinates, the surface forcing and the initial conditions required by
each sub-model when running a NEMO/AGRIF embedded mode
(see :download:`NESTING README <../../../tools/NESTING/README>`).
OBSTOOLS
--------
A series of Fortran utilities which are helpful in handling observation files and
the feedback file output from the NEMO observation operator.
Further info are available in the :doc:`Nemo manual <cite>`.
REBUILD_NEMO
------------
REBUILD_NEMO is a tool to rebuild NEMO output files from multiple processors
(mesh_mask, restart or XIOS output files) into one file
(see :download:`REBUILD_NEMO README <../../../tools/REBUILD_NEMO/README.rst>`).
REBUILD
-------
It contains the old version of REBUILD_NEMO tool based on the IOIPSL code.
SCOORD_GEN
----------
Offline tool to generate a vertical coordinates input file for use with S coordinates.
This has been carried out by copying the model code to an offline tool and then
modifying it to suppress the use of 3D arrays (to reduce memory usage).
The tool has been created in preparation for the removal of the vertical grid definition from
the code.
The output file should contain all variables that are necessary to restart the model.
SECTIONS_DIADCT
---------------
When the Transport across sections diagnostic is activated (``key_diadct``),
this tool is used to build the binary file containing the pathways between
the extremities of each section.
Further info are available in the :doc:`Nemo manual <cite>`.
SIREN
-----
SIREN is a configuration management tool to set up regional configurations with NEMO
(see :download:`SIREN README <../../../tools/SIREN/README>`).
WEIGHTS
-------
This directory contains software for generating and manipulating interpolation weights for use with
the Interpolation On the Fly (IOF) option in NEMO v3 onwards
(see :download:`WEIGHTS README <../../../tools/WEIGHTS/README>`).
TOYATM
------
This directory contains a simplified model that send/receive atmospheric fields to/from NEMO, for use in the CPL_OASIS sed to test case of the NEMO-OASIS coupling interface.
This toy requires OASIS3-MCT to be installed and properly defined in the arch file.
(see :download:`CPL_OASIS README <../../../tests/CPL_OASIS/README.md>`).
ABL_TOOLS
---------
3 steps to generate atmospheric forcings from ECMWF products for ABL1d model with NEMO:
- main_uvg_hpg (optional): geostrophic wind or horizontal pressure gradient computation on ECMWF eta-levels (to force ABL dynamics)
- main_vinterp: vertical interpolation from ECWMF vertical eta-levels to ABL Z-levels
- main_hdrown: 3D-fields horizontal drowning (extrapolation over land totally inspired from SOSIE by L. Brodeau)
(more details available in Lemarie et al. 2020 GMD)
tools/TOYATM/EXP/namcouple
View file @ 4a9f4b18
......@@ -6,7 +6,7 @@
# Any line beginning with # is ignored. Blank lines are not allowed
####################################################################
$NFIELDS
12
13
$END
############################################
$RUNTIME
......@@ -89,6 +89,15 @@ INT=1
BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_MSLP 1 5400 4 rst.nc EXPOUT
180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
100000. 0
BILINEAR LR SCALAR LATLON 1
INT=1
#
ATFLXEMP OTotRain 1 5400 3 rst.nc EXPOUT
180 90 180 148 lmdz torc
P 0 P 2
......