diff --git a/tools/NESTING/src/agrif_create_bathy.f90 b/tools/NESTING/src/agrif_create_bathy.f90 index fab9be5b7974675f2b55c05467c04d1966c440d5..cd92999a5d16fc1aa2e038f164df0efe9b709228 100644 --- a/tools/NESTING/src/agrif_create_bathy.f90 +++ b/tools/NESTING/src/agrif_create_bathy.f90 @@ -123,18 +123,20 @@ PROGRAM create_bathy ! check grids: if identical then do not interpolate identical_grids = .FALSE. - - IF( SIZE(G0%nav_lat,1) == SIZE(G1%nav_lat,1) .AND. SIZE(G0%nav_lat,2) == SIZE(G1%nav_lat,2) .AND. & - & SIZE(G0%nav_lon,1) == SIZE(G1%nav_lon,1) .AND. SIZE(G0%nav_lon,2) == SIZE(G1%nav_lon,2) ) THEN - IF( MAXVAL( ABS(G0%nav_lat(:,:)- G1%nav_lat(:,:)) ) < 0.0001 .AND. & - & MAXVAL( ABS(G0%nav_lon(:,:)- G1%nav_lon(:,:)) ) < 0.0001 ) THEN - WRITE(*,*) '' - WRITE(*,*) 'same grid between parent and child domains => NO INTERPOLATION' - WRITE(*,*) '' - G1%bathy_meter = G0%bathy_meter - identical_grids = .TRUE. - ENDIF - ENDIF + +!clem: comment these lines if one wants to create a zoom 1:1 and to change the bathymetry in the zoom +! +! IF( SIZE(G0%nav_lat,1) == SIZE(G1%nav_lat,1) .AND. SIZE(G0%nav_lat,2) == SIZE(G1%nav_lat,2) .AND. & +! & SIZE(G0%nav_lon,1) == SIZE(G1%nav_lon,1) .AND. SIZE(G0%nav_lon,2) == SIZE(G1%nav_lon,2) ) THEN +! IF( MAXVAL( ABS(G0%nav_lat(:,:)- G1%nav_lat(:,:)) ) < 0.0001 .AND. & +! & MAXVAL( ABS(G0%nav_lon(:,:)- G1%nav_lon(:,:)) ) < 0.0001 ) THEN +! WRITE(*,*) '' +! WRITE(*,*) 'same grid between parent and child domains => NO INTERPOLATION' +! WRITE(*,*) '' +! G1%bathy_meter = G0%bathy_meter +! identical_grids = .TRUE. +! ENDIF +! ENDIF IF( .NOT.new_topo ) type_bathy_interp = 2 ! only one which works ! @@ -270,8 +272,8 @@ PROGRAM create_bathy ALLOCATE(masksrc(SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2))) ALLOCATE(bathy_test(nxfin,nyfin)) ! - WHERE(G0%bathy_meter.LE.0) ; masksrc = .FALSE. ; - ELSEWHERE ; masksrc = .TRUE. ; + WHERE(G0%bathy_meter.LE.0.) ; masksrc = .FALSE. ; + ELSEWHERE ; masksrc = .TRUE. ; END WHERE ! ! compute remapping matrix thanks to SCRIP package diff --git a/tools/NESTING/src/agrif_create_restart.f90 b/tools/NESTING/src/agrif_create_restart.f90 index 9197147a7c52458a43cb1c06ea7cd92205e35c88..7e53f3db702ee2184bcdad35cb3bdceff9b58a91 100644 --- a/tools/NESTING/src/agrif_create_restart.f90 +++ b/tools/NESTING/src/agrif_create_restart.f90 @@ -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(*,*) '' diff --git a/tools/NESTING/src/agrif_interpolation.f90 b/tools/NESTING/src/agrif_interpolation.f90 index e28a0ef55a9730f1be0afa92de716918ab6d1fa9..bb507ffc9d01e0bae76a80f4997b5dbb4ac9c168 100644 --- a/tools/NESTING/src/agrif_interpolation.f90 +++ b/tools/NESTING/src/agrif_interpolation.f90 @@ -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) ! diff --git a/tools/NESTING/src/agrif_readwrite.f90 b/tools/NESTING/src/agrif_readwrite.f90 index 87e50abdd926ee0a4bdfc79b725645f22b07dfb5..f86aeea5eb1c4bac189fad4f1615d0464279a8db 100644 --- a/tools/NESTING/src/agrif_readwrite.f90 +++ b/tools/NESTING/src/agrif_readwrite.f90 @@ -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) ) diff --git a/tools/NESTING/src/bilinear_interp.f90 b/tools/NESTING/src/bilinear_interp.f90 index 695a700bc009d3990ec8e0a778b5b9eec05ac584..444eca5154004e8a32800ae413d1dc1654136a0b 100644 --- a/tools/NESTING/src/bilinear_interp.f90 +++ b/tools/NESTING/src/bilinear_interp.f90 @@ -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 diff --git a/tools/NESTING/src/io_netcdf.f90 b/tools/NESTING/src/io_netcdf.f90 index 98a407653f3b6ffefe2f3094a54ed6413908e2a8..b870cf5dc87fbf88daba1f972f83c43441831b3c 100644 --- a/tools/NESTING/src/io_netcdf.f90 +++ b/tools/NESTING/src/io_netcdf.f90 @@ -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