From 495f5a2efe74d3619495759972eb7bcd212ccef6 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 26 Sep 2023 10:23:25 -0400 Subject: [PATCH 01/55] preprocessing for routing --- .../Raster/preproc/routing/Pfaf_to_2d_30s.f90 | 59 + .../Utils/Raster/preproc/routing/build | 31 + .../preproc/routing/get_mask_MAPL_1d.ncl | 20 + .../preproc/routing/get_mask_MAPL_2d.f90 | 36 + .../routing/get_mask_TM0072xTM0036.f90 | 29 + .../get_oceanbond_TM0072xTM0036_mask.f90 | 53 + ...et_oceanbond_points_TM0072xTM0036_mask.f90 | 55 + .../routing/get_outlets_catchindex.ncl | 33 + .../preproc/routing/get_outlets_land.f90 | 87 + .../routing/get_outlets_ocean_allcat.f90 | 59 + .../preproc/routing/get_sinkxy_land.ncl | 19 + .../preproc/routing/get_sinkxy_ocean.ncl | 19 + .../preproc/routing/mv_outlets_ocean.f90 | 83 + .../Utils/Raster/preproc/routing/ncdioMod.f90 | 2582 +++++++++++++++++ .../preproc/routing/read_riveroutlet.f90 | 29 + .../Utils/Raster/preproc/routing/run.sh | 57 + .../Utils/Raster/preproc/routing/rwncMod.f90 | 530 ++++ 17 files changed, 3781 insertions(+) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/ncdioMod.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 new file mode 100755 index 000000000..7a577ce6d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 @@ -0,0 +1,59 @@ +program main + +use omp_lib +use rwncfile +implicit none + +character(len=100) :: var1="outlet_sinky_allcat_TM0072xTM0036_mask" +character(len=100) :: var2="outlet_sinkx_allcat_TM0072xTM0036_mask" +character(len=100) :: map="TM0072xTM0036-Pfafstetter_Greenland_real.nc" +integer,parameter :: nc=291809 +integer,parameter :: nlon=43200 +integer,parameter :: nlat=21600 + +real*8,allocatable :: lon(:),lat(:) +integer,allocatable :: catchind(:,:) +integer,allocatable :: data2d(:,:) +integer,allocatable :: data_Pfaf(:) + +integer :: xi,yi,id + + +allocate(catchind(nlon,nlat),data2d(nlon,nlat)) +allocate(lon(nlon),lat(nlat)) +call read_ncfile_double1d("inputs/"//trim(map),"lon",lon,nlon) +call read_ncfile_double1d("inputs/"//trim(map),"lat",lat,nlat) +call read_ncfile_int2d("inputs/"//trim(map),"data",catchind,nlon,nlat) + +allocate(data_Pfaf(nc)) + +open(77,file="outputs/"//trim(var1)//".txt") +read(77,*)data_Pfaf +data2d=-999 +do xi=1,nlon + do yi=1,nlat + if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nc)then + id=catchind(xi,yi) + data2d(xi,yi)=data_Pfaf(id) + endif + enddo +enddo +call create_ncfile_int2d_fill("outputs/"//trim(var1)//"_2d.nc","data",data2d,lon,lat,nlon,nlat,-999.) + +open(77,file="outputs/"//trim(var2)//".txt") +read(77,*)data_Pfaf +data2d=-999 +do xi=1,nlon + do yi=1,nlat + if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nc)then + id=catchind(xi,yi) + data2d(xi,yi)=data_Pfaf(id) + endif + enddo +enddo +call create_ncfile_int2d_fill("outputs/"//trim(var2)//"_2d.nc","data",data2d,lon,lat,nlon,nlat,-999.) + + + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build new file mode 100755 index 000000000..5914bf200 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build @@ -0,0 +1,31 @@ +#!/bin/bash + +if [ $# -lt 1 ]; then + echo "no f90 specified" + exit +fi + +string=$1 +array=(${string//./ }) + +FILENAME=${array[0]} + +#source /opt/intel/oneapi/setvars.sh + +#module load intel_compilers/19.0.5 +#module load intel_compilers/2021.3.0 + +#NETCDF_PATH=/usr/local/netcdf-4.2_optimized + +#NETCDF_PATH=/Users/zsp/opt/anaconda3/envs/ +#NETCDF_PATH=/usr/local/Cellar/netcdf-fortran/4.6.0 +#NETCDF_PATH=/usr/local/Cellar/netcdf/4.9.0 +#NETCDF_PATH=/Users/zsp/apps/netcdf-4.2.1.1 + +NETCDF_PATH=/discover/nobackup/yzeng3/apps/netcdf-4.2.1.1 + +ifort -qopenmp ncdioMod.f90 rwncMod.f90 ${FILENAME}.f90 -I$NETCDF_PATH/include -L$NETCDF_PATH/lib -L/usr/local/intel/oneapi/2021/compiler/2021.4.0/linux/lib -lnetcdf -lnetcdff -o ${FILENAME}.out + + +#ifort -O3 -m64 ${FILENAME}.f90 -I$NETCDF_PATH/include -L$NETCDF_PATH/lib -o ${FILENAME}.out + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl new file mode 100755 index 000000000..4382e44d2 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl @@ -0,0 +1,20 @@ +begin + +nt=2592 + +f=addfile("inputs/MAPL_Tripolar.nc","r") +msk_MAPL=f->mask + +t2lati=asciiread("inputs/TM0072xTM0036_tile_to_MAPL_lati.txt",nt,"integer") +t2loni=asciiread("inputs/TM0072xTM0036_tile_to_MAPL_loni.txt",nt,"integer") + +msk_tile=new(nt,integer) +msk_tile=msk_tile +do i=0,nt-1 + msk_tile(i)=toint(msk_MAPL(t2lati(i)-1,t2loni(i)-1)) +end do + +asciiwrite("outputs/mask_MAPL_1d_TM0072xTM0036.txt",msk_tile) + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 new file mode 100755 index 000000000..acf3aec00 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 @@ -0,0 +1,36 @@ +program main + +use omp_lib +use rwncfile +implicit none + +integer,parameter :: nlon=43200 +integer,parameter :: nlat=21600 +integer,parameter :: nt=2592 + +real*8,allocatable,dimension(:) :: lon,lat +integer,allocatable,dimension(:,:) :: landocean,mask +integer,allocatable,dimension(:) :: mask1d + +integer :: i,j,xi,yi,tid + +allocate(landocean(nlon,nlat)) +allocate(lon(nlon),lat(nlat)) +call read_ncfile_double1d("inputs/TM0072xTM0036.nc","lon",lon,nlon) +call read_ncfile_double1d("inputs/TM0072xTM0036.nc","lat",lat,nlat) +call read_ncfile_int2d("inputs/TM0072xTM0036.nc","data",landocean,nlon,nlat) + + +allocate(mask(nlon,nlat),mask1d(nt)) +open(77,file="outputs/mask_MAPL_1d_TM0072xTM0036.txt") +read(77,*)mask1d +do i=1,nlon + do j=1,nlat + tid=landocean(i,j) + mask(i,j)=mask1d(tid) + enddo +enddo +call create_ncfile_int2d("outputs/mask_MAPL_TM0072xTM0036.nc","data",mask,lon,lat,nlon,nlat) + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 new file mode 100755 index 000000000..be081341c --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 @@ -0,0 +1,29 @@ +program main + +use omp_lib +use rwncfile + +implicit none + +integer,parameter :: nlon=43200 +integer,parameter :: nlat=21600 +real*8,allocatable :: lon(:),lat(:) + +integer,allocatable,dimension(:,:) :: mask_mapl,mask_rst,mask + +allocate(mask_mapl(nlon,nlat),mask_rst(nlon,nlat),lon(nlon),lat(nlat),mask(nlon,nlat)) + +call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lon",lon,nlon) +call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lat",lat,nlat) +call read_ncfile_int2d("inputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","data",mask_rst,nlon,nlat) +call read_ncfile_int2d("outputs/mask_MAPL_TM0072xTM0036.nc","data",mask_mapl,nlon,nlat) + + +mask=0 +where(mask_rst==-9999..and.mask_mapl==1)mask=1 + +call create_ncfile_int2d("outputs/TM0072xTM0036_mask.nc","data",mask,lon,lat,nlon,nlat) + + + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 new file mode 100755 index 000000000..5e9091229 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 @@ -0,0 +1,53 @@ +program main + +use omp_lib +use rwncfile +implicit none + +integer,parameter :: nlon=43200 +integer,parameter :: nlat=21600 +real*8,allocatable :: lon(:),lat(:) + +integer,allocatable :: catchind(:,:) +integer,allocatable :: boundary(:,:) + +integer :: xi,yi,id +integer :: xp1,xm1,yp1,ym1 + +allocate(catchind(nlon,nlat),boundary(nlon,nlat),lon(nlon),lat(nlat)) +call read_ncfile_double1d("outputs/TM0072xTM0036_mask.nc","lon",lon,nlon) +call read_ncfile_double1d("outputs/TM0072xTM0036_mask.nc","lat",lat,nlat) +call read_ncfile_int2d("outputs/TM0072xTM0036_mask.nc","data",catchind,nlon,nlat) + +boundary=catchind +boundary=-9999 + +!$OMP PARALLEL default(shared) private(xi,yi,id) +!$OMP DO +do xi=2,nlon-1 + !if(mod(xi,100)==0)then + ! print *,xi + !endif + do yi=2,nlat-1 + id=catchind(xi,yi) + if(id==1)then + boundary(xi,yi)=0 + if(catchind(xi+1,yi)==1.and.& + catchind(xi+1,yi-1)==1.and.& + catchind(xi ,yi-1)==1.and.& + catchind(xi-1,yi-1)==1.and.& + catchind(xi-1,yi)==1.and.& + catchind(xi-1,yi+1)==1.and.& + catchind(xi ,yi+1)==1.and.& + catchind(xi+1,yi+1)==1)then + boundary(xi,yi)=-9999 + endif + endif + enddo +enddo +!$OMP END DO +!$OMP END PARALLEL + +call create_ncfile_int2d("outputs/TM0072xTM0036_mask_oceanboundary.nc","data",boundary,lon,lat,nlon,nlat) + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 new file mode 100755 index 000000000..0bc8a3a4d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 @@ -0,0 +1,55 @@ +program main + +use omp_lib +use rwncfile +implicit none + +integer,parameter :: nsh=788292 !304483 !1877262 +integer,parameter :: nlonh=43200 +integer,parameter :: nlath=21600 +real*8,allocatable :: lonh(:),lath(:) +integer,allocatable :: mskh(:,:) +real*8,allocatable :: lonsh(:),latsh(:) + +integer i,xi,yi,k + + +allocate(mskh(nlonh,nlath)) +allocate(lonh(nlonh),lath(nlath)) +call read_ncfile_double1d("outputs/TM0072xTM0036_mask_oceanboundary.nc","lon",lonh,nlonh) +call read_ncfile_double1d("outputs/TM0072xTM0036_mask_oceanboundary.nc","lat",lath,nlath) +call read_ncfile_int2d("outputs/TM0072xTM0036_mask_oceanboundary.nc","data",mskh,nlonh,nlath) + +allocate(lonsh(nsh),latsh(nsh)) + +k=0 +!!$OMP PARALLEL default(shared) shared(k) private(xi,yi) +!!$OMP DO +do xi=1,nlonh + do yi=1,nlath + if(mskh(xi,yi)==0)then + k=k+1 + lonsh(k)=lonh(xi) + latsh(k)=lath(yi) + endif + enddo +enddo +!!$OMP END DO +!!$OMP END PARALLEL +!print *,k + + +open(88,file="outputs/lon_oceanbond_list_TM0072xTM0036_mask.txt") +do i=1,nsh + write(88,*)lonsh(i) +enddo +open(88,file="outputs/lat_oceanbond_list_TM0072xTM0036_mask.txt") +do i=1,nsh + write(88,*)latsh(i) +enddo + + + + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl new file mode 100755 index 000000000..93d00248b --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl @@ -0,0 +1,33 @@ +begin +nc=291284 +ns=22612 +ng=525 + +msk=asciiread("inputs/Pfaf_msk.txt",nc,"integer") +outid=new(ns,integer) +k=0 +do i=0,nc-1 + if(msk(i).eq.2)then + outid(k)=i+1 + k=k+1 + end if +end do +do i=k,ns-1 + outid(i)=nc+i-k+1 +end do +asciiwrite("outputs/outlet_catchindex.txt",outid) + +mskall=new(nc+ng,integer) +mskall(0:nc-1)=msk +mskall(nc:)=2 +asciiwrite("outputs/Pfaf_msk_all.txt",mskall) + +final=asciiread("inputs/Pfaf_finalID.txt",nc,"integer") +finalall=new(nc+ng,integer) +finalall(0:nc-1)=final +do i=nc,nc+ng-1 + finalall(i)=i+1 +end do +asciiwrite("outputs/Pfaf_finalID_all.txt",finalall) + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 new file mode 100755 index 000000000..c67b25edf --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -0,0 +1,87 @@ +program main + +use omp_lib +use rwncfile +implicit none + +integer,parameter :: nc=291284 +integer,parameter :: nl=22087 +integer,parameter :: ng=525 +integer,parameter :: nlon=21600 +integer,parameter :: nlat=10800 + +real*8,allocatable :: lon(:),lat(:),long(:),latg(:),lons(:),lats(:) +integer,allocatable :: catchind(:,:) +real,allocatable :: acah(:,:) +integer,allocatable :: down(:),sx(:),sy(:),msk(:) +real,allocatable :: acas(:) + +integer :: id,xi,yi,i,k,xis,yis,ntot + +ntot=nl+ng +allocate(catchind(nlon,nlat),acah(nlon,nlat)) +allocate(lon(nlon),lat(nlat)) +allocate(sx(nc),sy(nc),acas(nc),down(nc),msk(nc)) +allocate(long(ng),latg(ng),lons(ntot),lats(ntot)) + +call read_ncfile_double1d("inputs/CatchIndex.nc","lon",lon,nlon) +call read_ncfile_double1d("inputs/CatchIndex.nc","lat",lat,nlat) +call read_ncfile_int2d("inputs/CatchIndex.nc","data",catchind,nlon,nlat) +call read_ncfile_real2d("inputs/HydroSHEDS_drainage_area.nc","data",acah,nlon,nlat) + + +open(77,file="inputs/downstream_1D_new_noadj.txt") +read(77,*)down +open(77,file="inputs/Pfaf_msk.txt") +read(77,*)msk + +acas=-9999. +sx=0 +sy=0 +do xi=1,nlon + do yi=1,nlat + if(catchind(xi,yi)>=1)then + id=catchind(xi,yi) + if(down(id)==-1.and.acah(xi,yi)>=acas(id))then + acas(id)=acah(xi,yi) + sx(id)=xi + sy(id)=yi + endif + endif + enddo +enddo + +where(down/=-1)sx=-1 +where(down/=-1)sy=-1 +k=0 +do i=1,nc + if(msk(i)==2)then + k=k+1 + lons(k)=lon(sx(i)) + lats(k)=lat(sy(i)) + endif +enddo +!print *,k + +open(77,file="inputs/Greenland_outlets_lat.txt") +read(77,*)latg +open(77,file="inputs/Greenland_outlets_lon.txt") +read(77,*)long + +lons(k+1:ntot)=long +lats(k+1:ntot)=latg + + +open(88,file="outputs/outlet_sinklat.txt") +do i=1,ntot + write(88,*)lats(i) +enddo +open(88,file="outputs/outlet_sinklon.txt") +do i=1,ntot + write(88,*)lons(i) +enddo + + + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 new file mode 100755 index 000000000..7c72e6333 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 @@ -0,0 +1,59 @@ +program main + +use omp_lib + +implicit none + +integer,parameter :: nall=291809 +integer,parameter :: nc=22612 + +integer, allocatable, dimension(:) :: id_final,id_outlet,msk +integer,allocatable,dimension(:) :: lati_outlet,loni_outlet +integer,allocatable,dimension(:) :: lati_full,loni_full + +integer :: i,j + +allocate(id_final(nall),id_outlet(nc),msk(nall),& + lati_outlet(nc),loni_outlet(nc),lati_full(nall),loni_full(nall)) + +open(77,file="outputs/Pfaf_finalID_all.txt") +read(77,*)id_final +open(77,file="outputs/outlet_catchindex.txt") +read(77,*)id_outlet +open(77,file="outputs/outlet_sinky_TM0072xTM0036_mask.txt") +read(77,*)lati_outlet +open(77,file="outputs/outlet_sinkx_TM0072xTM0036_mask.txt") +read(77,*)loni_outlet +open(77,file="outputs/Pfaf_msk_all.txt") +read(77,*)msk + +lati_full=-999 +loni_full=-999 + +do i=1,nall + !if(mod(i,1000)==0) print *,i + if(msk(id_final(i)).eq.2)then + do j=1,nc + if(id_outlet(j).eq.id_final(i))then + lati_full(i)=lati_outlet(j) + loni_full(i)=loni_outlet(j) + end if + enddo + else if(msk(id_final(i)).eq.3)then + lati_full(i)=-999 + loni_full(i)=-999 + endif +end do + +open(88,file="outputs/outlet_sinky_allcat_TM0072xTM0036_mask.txt") +do i=1,nall + write(88,*)lati_full(i) +enddo +open(88,file="outputs/outlet_sinkx_allcat_TM0072xTM0036_mask.txt") +do i=1,nall + write(88,*)loni_full(i) +enddo + + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl new file mode 100755 index 000000000..22b32627e --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl @@ -0,0 +1,19 @@ +begin + +ns=22612 +nlat=21600 +nlon=43200 + +lat=asciiread("outputs/outlet_sinklat.txt",ns,"double") +lon=asciiread("outputs/outlet_sinklon.txt",ns,"double") + +lat30s=asciiread("inputs/lat_30s.txt",nlat,"double") +lon30s=asciiread("inputs/lon_30s.txt",nlon,"double") + +lati=ind_nearest_coord(lat,lat30s,0) +loni=ind_nearest_coord(lon,lon30s,0) + +asciiwrite("outputs/outlet_sinky.txt",lati+1) +asciiwrite("outputs/outlet_sinkx.txt",loni+1) + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl new file mode 100755 index 000000000..33d1e7d53 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl @@ -0,0 +1,19 @@ +begin + +ns=22612 +nlat=21600 +nlon=43200 + +lat=asciiread("outputs/outlet_sinklat_TM0072xTM0036_mask.txt",ns,"double") +lon=asciiread("outputs/outlet_sinklon_TM0072xTM0036_mask.txt",ns,"double") + +lat30s=asciiread("inputs/lat_30s.txt",nlat,"double") +lon30s=asciiread("inputs/lon_30s.txt",nlon,"double") + +lati=ind_nearest_coord(lat,lat30s,0) +loni=ind_nearest_coord(lon,lon30s,0) + +asciiwrite("outputs/outlet_sinky_TM0072xTM0036_mask.txt",lati+1) +asciiwrite("outputs/outlet_sinkx_TM0072xTM0036_mask.txt",loni+1) + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 new file mode 100755 index 000000000..5533e7d00 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 @@ -0,0 +1,83 @@ +program main + +use omp_lib +use rwncfile +implicit none + +integer,parameter :: nsh=788292 +integer,parameter :: ns=22612 +integer,parameter :: nlon=43200 +integer,parameter :: nlat=21600 + +integer,allocatable :: mask(:,:) + +real*8 :: lons(ns),lats(ns) +integer :: lonsi(ns),latsi(ns) +real*8 :: lons_adj(ns),lats_adj(ns) +real*8,allocatable :: lonsh(:),latsh(:) +integer :: catid(ns),flag(ns) + +real :: dist(ns) + +integer :: i,j +real :: dy,dy2,dx,dx2,dxA,dxB,dist_temp + +allocate(lonsh(nsh),latsh(nsh)) + +open(77,file="outputs/outlet_sinklon.txt") +read(77,*)lons +open(77,file="outputs/outlet_sinklat.txt") +read(77,*)lats +open(77,file="outputs/outlet_sinkx.txt") +read(77,*)lonsi +open(77,file="outputs/outlet_sinky.txt") +read(77,*)latsi + +open(77,file="outputs/lon_oceanbond_list_TM0072xTM0036_mask.txt") +read(77,*)lonsh +open(77,file="outputs/lat_oceanbond_list_TM0072xTM0036_mask.txt") +read(77,*)latsh + +allocate(mask(nlon,nlat)) +call read_ncfile_int2d("outputs/TM0072xTM0036_mask.nc","data",mask,nlon,nlat) + +!$OMP PARALLEL default(shared) private(i,j,dy,dy2,dx,dx2,dxA,dxB,dist_temp) +!$OMP DO +do i=1,ns + !if(mod(i,100)==0) print *,i + IF(mask(lonsi(i),latsi(i))==0)THEN + dist(i)=1.e12 + do j=1,nsh + dy=abs(lats(i)-latsh(j)) + dy2=dy*dy + dxA=abs(lons(i)-lonsh(j)) + dxB=360.-dxA + dx=min(dxA,dxB) + dx2=dx*dx + dist_temp=sqrt(dx2+dy2) + if(dist_temp variable is on initial dataset (read only) +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! variable id + integer :: ndim ! dimension counter + integer :: start(4) ! starting indices for netcdf field + integer :: count(4) ! count values for netcdf field + character(len=32) :: inq_name ! inquid variable name + character(len=8) :: inq_xtype ! inquid variable type + integer :: inq_ndims ! inquid variable dimention + integer :: inq_dimids(4) ! inquid variable dimention id + character(len=255) :: inq_natts ! inquid variable attachment + character(len=32) :: subname='NCD_IOLOCAL_INT_1D' ! subroutine name + logical :: varpresent ! if true, variable is on tape +!----------------------------------------------------------------------- + + ! Write field as 1d field + if (flag == 'write') then + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + ! Write 1d field + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_put_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if ! end of if-nc_masterproc block + ! Read field as 1d field + else if (flag == 'read') then + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + !read data + call check_ret(nf_get_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + else + call endrun('the varibal does not difined!',subname) + end if + end if + if (present(readvar)) readvar = varpresent + end if + + end subroutine ncd_iolocal_int_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_iolocal_real_1d +! +! !INTERFACE: + subroutine ncd_iolocal_real_1d(varname, data, flag, ncid, & + lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & + long_name, units, readvar) +! 读/写局部一维实型变量:将一笔资料阵列写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! lb_lon--经向的起始号 +! lb_lat--纬向的起始号 +! lb_lvl--层次的起始号 +! lb_t--时间的起始号 +! ub_lon--经向的起始号 +! ub_lat--纬向的起始号 +! ub_lvl--层次的起始号 +! ub_t--时间的起始号 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O for 1d int field +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + real, intent(inout) :: data(:) ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + integer , optional, intent(in) :: lb_lon ! start for longitude + integer , optional, intent(in) :: lb_lat ! start for latitute sizes + integer , optional, intent(in) :: lb_lvl ! start for level size + integer , optional, intent(in) :: lb_t ! start for time size + integer , optional, intent(in) :: ub_lon ! start for longitude + integer , optional, intent(in) :: ub_lat ! start for latitute sizes + integer , optional, intent(in) :: ub_lvl ! start for level size + integer , optional, intent(in) :: ub_t ! start for time size + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! variable id + integer :: ndim ! dimension counter + integer :: start(4) ! starting indices for netcdf field + integer :: count(4) ! count values for netcdf field + character(len=32) :: inq_name ! inquid variable name + character(len=8) :: inq_xtype ! inquid variable type + integer :: inq_ndims ! inquid variable dimention + integer :: inq_dimids(4) ! inquid variable dimention id + character(len=255) :: inq_natts ! inquid variable attachment + character(len=32) :: subname='NCD_IOLOCAL_REAL_1D' ! subroutine name + logical :: varpresent ! if true, variable is on tape +!----------------------------------------------------------------------- + + ! Write field as 1d field + if (flag == 'write') then + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + ! Write 1d field + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_put_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if ! end of if-nc_masterproc block + ! Read field as 1d field + else if (flag == 'read') then + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + !read data + call check_ret(nf_get_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + else + call endrun('the varibal does not difined!',subname) + end if + end if + if (present(readvar)) readvar = varpresent + end if + + end subroutine ncd_iolocal_real_1d +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_iolocal_real_1d +! +! !INTERFACE: + subroutine ncd_iolocal_double_1d(varname, data, flag, ncid, & + lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & + long_name, units, readvar) +! 读/写局部一维实型变量:将一笔资料阵列写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! lb_lon--经向的起始号 +! lb_lat--纬向的起始号 +! lb_lvl--层次的起始号 +! lb_t--时间的起始号 +! ub_lon--经向的起始号 +! ub_lat--纬向的起始号 +! ub_lvl--层次的起始号 +! ub_t--时间的起始号 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O for 1d int field +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + real*8, intent(inout) :: data(:) ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + integer , optional, intent(in) :: lb_lon ! start for longitude + integer , optional, intent(in) :: lb_lat ! start for latitute sizes + integer , optional, intent(in) :: lb_lvl ! start for level size + integer , optional, intent(in) :: lb_t ! start for time size + integer , optional, intent(in) :: ub_lon ! start for longitude + integer , optional, intent(in) :: ub_lat ! start for latitute sizes + integer , optional, intent(in) :: ub_lvl ! start for level size + integer , optional, intent(in) :: ub_t ! start for time size + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! variable id + integer :: ndim ! dimension counter + integer :: start(4) ! starting indices for netcdf field + integer :: count(4) ! count values for netcdf field + character(len=32) :: inq_name ! inquid variable name + character(len=8) :: inq_xtype ! inquid variable type + integer :: inq_ndims ! inquid variable dimention + integer :: inq_dimids(4) ! inquid variable dimention id + character(len=255) :: inq_natts ! inquid variable attachment + character(len=32) :: subname='NCD_IOLOCAL_REAL_1D' ! subroutine name + logical :: varpresent ! if true, variable is on tape +!----------------------------------------------------------------------- + + ! Write field as 1d field + if (flag == 'write') then + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + ! Write 1d field + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_put_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if ! end of if-nc_masterproc block + ! Read field as 1d field + else if (flag == 'read') then + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + !read data + call check_ret(nf_get_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + else + call endrun('the varibal does not difined!',subname) + end if + end if + if (present(readvar)) readvar = varpresent + end if + + end subroutine ncd_iolocal_double_1d +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_iolocal_int_2d +! +! !INTERFACE: + subroutine ncd_iolocal_int_2d(varname, data, flag, ncid, & + lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & + long_name, units, readvar) +! 读/写局部二维整型变量:将一笔资料阵列写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! lb_lon--经向的起始号 +! lb_lat--纬向的起始号 +! lb_lvl--层次的起始号 +! lb_t--时间的起始号 +! ub_lon--经向的起始号 +! ub_lat--纬向的起始号 +! ub_lvl--层次的起始号 +! ub_t--时间的起始号 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O for 2d real field +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + integer , intent(inout) :: data(:,:) ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + integer , optional, intent(in) :: lb_lon ! start for longitude + integer , optional, intent(in) :: lb_lat ! start for latitute sizes + integer , optional, intent(in) :: lb_lvl ! start for level size + integer , optional, intent(in) :: lb_t ! start for time size + integer , optional, intent(in) :: ub_lon ! start for longitude + integer , optional, intent(in) :: ub_lat ! start for latitute sizes + integer , optional, intent(in) :: ub_lvl ! start for level size + integer , optional, intent(in) :: ub_t ! start for time size + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! variable id + integer :: ndim ! dimension counter + integer :: start(4) ! starting indices for netcdf field + integer :: count(4) ! count values for netcdf field + character(len=32) :: inq_name ! inquid variable name + character(len=8) :: inq_xtype ! inquid variable type + integer :: inq_ndims ! inquid variable dimention + integer :: inq_dimids(4) ! inquid variable dimention id + character(len=255) :: inq_natts ! inquid variable attachment + character(len=32) :: subname='NCD_IOLOCAL_INT_2D' ! subroutine name + logical :: varpresent ! if true, variable is on tape +!----------------------------------------------------------------------- + + ! Write field as 2d field + if (flag == 'write') then + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + ! Write 2d field + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_put_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if ! end of if-nc_masterproc block + ! Read field as 1d field + else if (flag == 'read') then + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_get_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + else + call endrun('the varibal does not difined!',subname) + end if + end if + if (present(readvar)) readvar = varpresent + end if + + end subroutine ncd_iolocal_int_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_iolocal_real_2d +! +! !INTERFACE: + subroutine ncd_iolocal_real_2d(varname, data, flag, ncid, & + lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & + long_name, units, readvar) +! 读/写局部二维实型变量:将一笔资料阵列写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! lb_lon--经向的起始号 +! lb_lat--纬向的起始号 +! lb_lvl--层次的起始号 +! lb_t--时间的起始号 +! ub_lon--经向的起始号 +! ub_lat--纬向的起始号 +! ub_lvl--层次的起始号 +! ub_t--时间的起始号 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O for 2d real field +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + real, intent(inout) :: data(:,:) ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + integer , optional, intent(in) :: lb_lon ! start for longitude + integer , optional, intent(in) :: lb_lat ! start for latitute sizes + integer , optional, intent(in) :: lb_lvl ! start for level size + integer , optional, intent(in) :: lb_t ! start for time size + integer , optional, intent(in) :: ub_lon ! start for longitude + integer , optional, intent(in) :: ub_lat ! start for latitute sizes + integer , optional, intent(in) :: ub_lvl ! start for level size + integer , optional, intent(in) :: ub_t ! start for time size + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! variable id + integer :: ndim ! dimension counter + integer :: start(4) ! starting indices for netcdf field + integer :: count(4) ! count values for netcdf field + character(len=32) :: inq_name ! inquid variable name + character(len=8) :: inq_xtype ! inquid variable type + integer :: inq_ndims ! inquid variable dimention + integer :: inq_dimids(4) ! inquid variable dimention id + character(len=255) :: inq_natts ! inquid variable attachment + character(len=32) :: subname='NCD_IOLOCAL_REAL_2D' ! subroutine name + logical :: varpresent ! if true, variable is on tape +!----------------------------------------------------------------------- + + ! Write field as 2d field + if (flag == 'write') then + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + ! Write 2d field + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_put_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if ! end of if-nc_masterproc block + ! Read field as 1d field + else if (flag == 'read') then + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_get_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + else + call endrun('the varibal does not difined!',subname) + end if + end if + if (present(readvar)) readvar = varpresent + end if + + end subroutine ncd_iolocal_real_2d + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_iolocal_real_2d +! +! !INTERFACE: + subroutine ncd_iolocal_double_2d(varname, data, flag, ncid, & + lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & + long_name, units, readvar) +! 读/写局部二维实型变量:将一笔资料阵列写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! lb_lon--经向的起始号 +! lb_lat--纬向的起始号 +! lb_lvl--层次的起始号 +! lb_t--时间的起始号 +! ub_lon--经向的起始号 +! ub_lat--纬向的起始号 +! ub_lvl--层次的起始号 +! ub_t--时间的起始号 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O for 2d real field +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + real*8, intent(inout) :: data(:,:) ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + integer , optional, intent(in) :: lb_lon ! start for longitude + integer , optional, intent(in) :: lb_lat ! start for latitute sizes + integer , optional, intent(in) :: lb_lvl ! start for level size + integer , optional, intent(in) :: lb_t ! start for time size + integer , optional, intent(in) :: ub_lon ! start for longitude + integer , optional, intent(in) :: ub_lat ! start for latitute sizes + integer , optional, intent(in) :: ub_lvl ! start for level size + integer , optional, intent(in) :: ub_t ! start for time size + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! variable id + integer :: ndim ! dimension counter + integer :: start(4) ! starting indices for netcdf field + integer :: count(4) ! count values for netcdf field + character(len=32) :: inq_name ! inquid variable name + character(len=8) :: inq_xtype ! inquid variable type + integer :: inq_ndims ! inquid variable dimention + integer :: inq_dimids(4) ! inquid variable dimention id + character(len=255) :: inq_natts ! inquid variable attachment + character(len=32) :: subname='NCD_IOLOCAL_REAL_2D' ! subroutine name + logical :: varpresent ! if true, variable is on tape +!----------------------------------------------------------------------- + + ! Write field as 2d field + if (flag == 'write') then + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + ! Write 2d field + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_put_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if ! end of if-nc_masterproc block + ! Read field as 1d field + else if (flag == 'read') then + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + ndim=0 + count=1 + if (present(lb_lon) .and. present(ub_lon)) then + ndim=ndim+1 + start(ndim)=lb_lon + count(ndim)=ub_lon-lb_lon+1 + else if(present(lb_lon) .neqv. present(ub_lon))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lat)) then + ndim=ndim+1 + start(ndim)=lb_lat + count(ndim)=ub_lat-lb_lat+1 + else if(present(lb_lat) .neqv. present(ub_lat))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_lvl)) then + ndim=ndim+1 + start(ndim)=lb_lvl + count(ndim)=ub_lvl-lb_lvl+1 + else if(present(lb_lvl) .neqv. present(ub_lvl))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + if (present(lb_t)) then + ndim=ndim+1 + start(ndim)=lb_t + count(ndim)=ub_t-lb_t+1 + else if(present(lb_t) .neqv. present(lb_t))then + call endrun('must specify the low and up boundary at the same time!',subname) + endif + + if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & + (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then + call endrun('must specify one dimention!',subname) + endif + + call check_ret(nf_get_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) + else + call endrun('the varibal does not difined!',subname) + end if + end if + if (present(readvar)) readvar = varpresent + end if + + end subroutine ncd_iolocal_double_2d + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_int_var +! +! !INTERFACE: + subroutine ncd_ioglobal_int_var(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局零维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O of integer variable +! + +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + integer , intent(inout) :: data ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: ier ! error status + integer :: dimid(1) ! dimension id + integer :: start(1), count(1) ! output bounds + integer :: varid ! variable id + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_INT_VAR' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = nt; count(1) = 1 + call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_int(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_int_var + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_var +! +! !INTERFACE: + subroutine ncd_ioglobal_real_var(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局零维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O of real variable +! + +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + real , intent(inout) :: data ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: ier ! error status + integer :: dimid(1) ! dimension id + integer :: start(1), count(1) ! output bounds + integer :: varid ! variable id + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_VAR' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = nt; count(1) = 1 + call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_real(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_real(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_real_var + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_var +! +! !INTERFACE: + subroutine ncd_ioglobal_double_var(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局零维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! I/O of real variable +! + +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: varname ! variable name + real*8 , intent(inout) :: data ! local decomposition data + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: ier ! error status + integer :: dimid(1) ! dimension id + integer :: start(1), count(1) ! output bounds + integer :: varid ! variable id + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_VAR' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = nt; count(1) = 1 + call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_double(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_double(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_double_var + +!---------------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_int_1d +! +! !INTERFACE: + subroutine ncd_ioglobal_int_1d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局一维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! Master I/O for 1d integer data +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer , intent(inout) :: data(:) ! local decomposition data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(2), ndims ! dimension ids + integer :: start(2), count(2) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_INT_1D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data) + start(2) = nt; count(2) = 1 + call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_int(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_int_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_1d +! +! !INTERFACE: + subroutine ncd_ioglobal_real_1d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局一维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! Master I/O for 1d real data +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + real , intent(inout) :: data(:) ! local decomposition input data + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: ier ! error code + integer :: dimid(2), ndims ! dimension ids + integer :: start(2), count(2) ! output bounds + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_1D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data) + start(2) = nt; count(2) = 1 + call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) + else +! call check_ret(nf_put_var_real(ncid, varid, data), subname) +call check_ret(nf_put_var_real(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_real(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_real_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_1d +! +! !INTERFACE: + subroutine ncd_ioglobal_double_1d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局一维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! Master I/O for 1d real data +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + real*8 , intent(inout) :: data(:) ! local decomposition input data + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: ier ! error code + integer :: dimid(2), ndims ! dimension ids + integer :: start(2), count(2) ! output bounds + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_1D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data) + start(2) = nt; count(2) = 1 + call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) + else +! call check_ret(nf_put_var_double(ncid, varid, data), subname) +call check_ret(nf_put_var_double(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_double(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_double_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_int_2d +! +! !INTERFACE: + subroutine ncd_ioglobal_int_2d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 2d integer array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer , intent(inout) :: data(:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(3), ndims ! dimension ids + integer :: start(3), count(3) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_2D_INT_IO' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = nt; count(3) = 1 + call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_int(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_int_2d + +!----------------------------------------------------------------------- + +!BOP +! +! !IROUTINE: ncd_ioglobal_int_2d +! +! !INTERFACE: + subroutine ncd_ioglobal_long_2d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 2d integer array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer*8 , intent(inout) :: data(:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(3), ndims ! dimension ids + integer :: start(3), count(3) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_2D_INT_IO' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = nt; count(3) = 1 + call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_int(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_long_2d + +!----------------------------------------------------------------------- + +!BOP +! +! !IROUTINE: ncd_ioglobal_byte_2d +! +! !INTERFACE: + subroutine ncd_ioglobal_byte_2d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 2d integer array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + byte, intent(inout) :: data(:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(3), ndims ! dimension ids + integer :: start(3), count(3) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_2D_INT1_IO' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = nt; count(3) = 1 + call check_ret(nf_put_vara_int1(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int1(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_int1(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_byte_2d +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_short_2d +! +! !INTERFACE: + subroutine ncd_ioglobal_short_2d(varname, data, flag, ncid, long_name, units, nt, readvar) +! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 2d integer array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer*2, intent(inout) :: data(:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(3), ndims ! dimension ids + integer :: start(3), count(3) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_2D_INT2_IO' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = nt; count(3) = 1 + call check_ret(nf_put_vara_int2(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int2(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_int2(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_short_2d +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_2d +! +! !INTERFACE: + subroutine ncd_ioglobal_real_2d(varname, data, flag, & + ncid, long_name, units, nt, readvar) +! 读/写全局二维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! long_name--属性-变量全称 +! units--属性-变量单位 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 2d real array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + real , intent(inout) :: data(:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: ier ! error code + integer :: dimid(3), ndims ! dimension ids + integer :: start(3), count(3) ! output bounds + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_2D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = nt; count(3) = 1 +! call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) +call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_real(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_real(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_real_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_2d +! +! !INTERFACE: + subroutine ncd_ioglobal_double_2d(varname, data, flag, & + ncid, long_name, units, nt, readvar) +! 读/写全局二维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! long_name--属性-变量全称 +! units--属性-变量单位 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 2d real array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + real*8 , intent(inout) :: data(:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: ier ! error code + integer :: dimid(3), ndims ! dimension ids + integer :: start(3), count(3) ! output bounds + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_2D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = nt; count(3) = 1 +! call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) +call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_double(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + call check_ret(nf_get_var_double(ncid, varid, data), subname) + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_double_2d +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_short_3d +! +! !INTERFACE: + subroutine ncd_ioglobal_short_3d(varname, data, flag, & + ncid, long_name, units, nt, readvar) +! 读/写全局三维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! long_name--属性-变量全称 +! units--属性-变量单位 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 3d integer array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer*2 , intent(inout) :: data(:,:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(4), ndims ! dimension ids + integer :: start(4), count(4) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_3D_INT2_IO' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_put_vara_int2(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int2(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_get_vara_int2(ncid, varid, start, count, data), subname) + else + call check_ret(nf_get_var_int2(ncid, varid, data), subname) + end if + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_short_3d +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_int_3d +! +! !INTERFACE: + subroutine ncd_ioglobal_int_3d(varname, data, flag, & + ncid, long_name, units, nt, readvar) +! 读/写全局三维整型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! long_name--属性-变量全称 +! units--属性-变量单位 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 3d integer array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer , intent(inout) :: data(:,:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: dimid(4), ndims ! dimension ids + integer :: start(4), count(4) ! output bounds + integer :: ier ! error code + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_3D_INT_IO' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_int(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_get_vara_int(ncid, varid, start, count, data), subname) + else + call check_ret(nf_get_var_int(ncid, varid, data), subname) + end if + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_int_3d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_3d +! +! !INTERFACE: + subroutine ncd_ioglobal_real_3d(varname, data, flag, & + ncid, long_name, units, nt, readvar) +! 读/写全局三维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! long_name--属性-变量全称 +! units--属性-变量单位 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 3d real array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + real, intent(inout) :: data(:,:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: ier ! error code + integer :: dimid(4), ndims ! dimension ids + integer :: start(4), count(4) ! output bounds + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_3D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_real(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_get_vara_real(ncid, varid, start, count, data), subname) + else + call check_ret(nf_get_var_real(ncid, varid, data), subname) + end if + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_real_3d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_ioglobal_real_3d +! +! !INTERFACE: + subroutine ncd_ioglobal_double_3d(varname, data, flag, & + ncid, long_name, units, nt, readvar) +! 读/写全局三维实型变量:将所有的资料阵列均写入档案中 +! varname--变量名 +! data--变量存储数组 +! long_name--属性-变量全称 +! units--属性-变量单位 +! flag--读/写的标记 +! ncid--NC文件对应的文件号 +! nt--时间步 +! readvar--所读取的变量是否存在于该NC文件中 +! !DESCRIPTION: +! netcdf I/O of global 3d real array +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: flag ! 'read' or 'write' + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + real*8, intent(inout) :: data(:,:,:) ! local decomposition input data + character(len=*), optional, intent(in) :: long_name ! variable long name + character(len=*), optional, intent(in) :: units ! variable units + logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) + integer , optional, intent(in) :: nt ! time sample index +! +! !REVISION HISTORY: +! +!EOP +! +! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: ier ! error code + integer :: dimid(4), ndims ! dimension ids + integer :: start(4), count(4) ! output bounds + logical :: varpresent ! if true, variable is on tape + character(len=32) :: subname='NCD_IOGLOBAL_REAL_3D' ! subroutine name +!----------------------------------------------------------------------- + + if (flag == 'write') then + + if (nc_masterproc) then + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) + else + call check_ret(nf_put_var_double(ncid, varid, data), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + end if + + else if (flag == 'read') then + + if (nc_masterproc) then + call check_var(ncid, varname, varid, varpresent) + if (varpresent) then + if (present(nt)) then + start(1) = 1; count(1) = size(data, dim=1) + start(2) = 1; count(2) = size(data, dim=2) + start(3) = 1; count(3) = size(data, dim=3) + start(4) = nt; count(4) = 1 + call check_ret(nf_get_vara_double(ncid, varid, start, count, data), subname) + else + call check_ret(nf_get_var_double(ncid, varid, data), subname) + end if + else + call endrun('the varibal does not difined!',subname) + endif + end if + if (present(readvar)) readvar = varpresent + + end if + + end subroutine ncd_ioglobal_double_3d + +!----------------------------------------------------------------------- +!BOP +! !IROUTINE: endrun +! +! !INTERFACE: +subroutine endrun(msg,subname) +! +! !DESCRIPTION: +! Abort the model for abnormal termination + implicit none +! !ARGUMENTS: + character(len=*), intent(in), optional :: msg ! string to be printed + character(len=*), intent(in), optional :: subname ! subname + + if (present (subname)) then + write(6,*) 'ERROR in subroutine :', trim(subname) + end if + + if (present (msg)) then + write(6,*)'ENDRUN:', msg + else + write(6,*) 'ENDRUN: called without a message string' + end if + + stop +end subroutine endrun + +end module ncdio + + + + + + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 new file mode 100755 index 000000000..2d93bef6d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 @@ -0,0 +1,29 @@ +program main + +use omp_lib +use rwncfile + +implicit none + +character(len=100) :: lonfile="outlet_sinkx_allcat_TM0072xTM0036_mask_2d.nc" +character(len=100) :: latfile="outlet_sinky_allcat_TM0072xTM0036_mask_2d.nc" +integer, parameter :: nx=43200, ny=21600 +integer, allocatable :: lats(:,:), lons(:,:) +integer i,j + +allocate(lats(nx,ny), lons(nx,ny)) + +call read_ncfile_int2d("outputs/"//trim(latfile),"data",lats,nx,ny) +call read_ncfile_int2d("outputs/"//trim(lonfile),"data",lons,nx,ny) + + +open(30,file="outlet_file/Outlet_latlon.43200x21600",form="unformatted") + + +do j = 1, ny + write (30) lons(:,j) + write (30) lats(:,j) +end do + + +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh new file mode 100755 index 000000000..0cf16eeb6 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh @@ -0,0 +1,57 @@ +#!/bin/bash +set -e + +echo "Building get_outlets_land.f90 ..." +./build get_outlets_land.f90 +echo "Building get_mask_MAPL_2d.f90 ..." +./build get_mask_MAPL_2d.f90 +echo "Building get_mask_TM0072xTM0036.f90 ..." +./build get_mask_TM0072xTM0036.f90 +echo "Building get_oceanbond_TM0072xTM0036_mask.f90 ..." +./build get_oceanbond_TM0072xTM0036_mask.f90 +echo "Building get_oceanbond_points_TM0072xTM0036_mask.f90 ..." +./build get_oceanbond_points_TM0072xTM0036_mask.f90 +echo "Building mv_outlets_ocean.f90 ..." +./build mv_outlets_ocean.f90 +echo "Building get_outlets_ocean_allcat.f90 ..." +./build get_outlets_ocean_allcat.f90 +echo "Building Pfaf_to_2d_30s.f90 ..." +./build Pfaf_to_2d_30s.f90 +echo "Building read_riveroutlet.f90 ..." +./build read_riveroutlet.f90 + +echo "running get_outlets_catchindex.ncl" +ncl get_outlets_catchindex.ncl +echo "running get_outlets_land.out" +./get_outlets_land.out +echo "running get_sinkxy_land.ncl" +ncl get_sinkxy_land.ncl + +echo "running get_mask_MAPL_1d.ncl" +ncl get_mask_MAPL_1d.ncl +echo "running get_mask_MAPL_2d.out" +./get_mask_MAPL_2d.out +echo "running get_mask_TM0072xTM0036.out" +./get_mask_TM0072xTM0036.out +echo "running get_oceanbond_TM0072xTM0036_mask.out" +./get_oceanbond_TM0072xTM0036_mask.out +echo "running get_oceanbond_points_TM0072xTM0036_mask.out" +./get_oceanbond_points_TM0072xTM0036_mask.out +echo "running mv_outlets_ocean.out" +./mv_outlets_ocean.out +echo "running get_sinkxy_ocean.ncl" +ncl get_sinkxy_ocean.ncl + +echo "running get_outlets_ocean_allcat.out" +./get_outlets_ocean_allcat.out +echo "running Pfaf_to_2d_30s.out" +./Pfaf_to_2d_30s.out +echo "running read_riveroutlet.out" +./read_riveroutlet.out +echo "Outlet_latlon.43200x2160 created!" + +echo "Removing temporary output files ..." +rm -f outputs/* +echo "Removing *.out files ..." +rm -f *.out +rm -f *.mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 new file mode 100755 index 000000000..dcab17e30 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 @@ -0,0 +1,530 @@ +module rwncfile + + use ncdio + implicit none + + public :: read_ncfile_real1d + public :: read_ncfile_double1d + + public :: read_ncfile_int2d + public :: read_ncfile_int3d + public :: read_ncfile_real2d + public :: read_ncfile_real3d + public :: read_ncfile_double2d + public :: read_ncfile_double3d + + public :: write_ncfile_int2d + public :: write_ncfile_real2d + public :: write_ncfile_double2d + + public :: create_ncfile_byte2d + public :: create_ncfile_short2d + public :: create_ncfile_short3d + public :: create_ncfile_int3d + public :: create_ncfile_int2d + public :: create_ncfile_int2d_fill + + public :: create_ncfile_long2d + public :: create_ncfile_real2d + public :: create_ncfile_real3d + public :: create_ncfile_double2d + + contains +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_real1d(filename,varname,var,n) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: n + real, intent(inout) :: var(n) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_real(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_real1d +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_double1d(filename,varname,var,n) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: n + real*8, intent(inout) :: var(n) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_double(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_double1d +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_int2d(filename,varname,var,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + integer, intent(inout) :: var(nlon,nlat) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_int(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_int2d +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_int3d(filename,varname,var,nlon,nlat,nlev) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat, nlev + integer, intent(inout) :: var(nlon,nlat,nlev) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_int(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_int3d +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_real2d(filename,varname,var,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + real, intent(inout) :: var(nlon,nlat) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_real(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_real2d +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_real3d(filename,varname,var,nlon,nlat,nlev) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat, nlev + real, intent(inout) :: var(nlon,nlat,nlev) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_real(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_real3d +!------------------------------------------------------------------------------------------ + subroutine read_ncfile_double2d(filename,varname,var,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + real*8, intent(inout) :: var(nlon,nlat) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_double(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_double2d + + + subroutine read_ncfile_double3d(filename,varname,var,nlon,nlat,nlev) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat, nlev + real*8, intent(inout) :: var(nlon,nlat,nlev) + + character(len=4) :: subname="read" + integer :: ncid, varid + + call check_ret(nf_open(filename,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,varname,varid),subname) + call check_ret(nf_get_var_double(ncid,varid,var),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_ncfile_double3d +!------------------------------------------------------------------------------------------ + subroutine write_ncfile_int2d(filename,varname,var,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + integer, intent(inout) :: var(nlon,nlat) + + character(len=4) :: subname="write" + integer :: ncid, varid, omode + + call check_ret(nf_open(filename, nf_write, ncid), subname) + call check_ret(nf_set_fill(ncid, nf_nofill, omode), subname) + call ncd_ioglobal(varname=varname, data=var, ncid=ncid, flag='write') + call check_ret(nf_sync(ncid), subname) + call check_ret(nf_close(ncid), subname) + end subroutine write_ncfile_int2d +!------------------------------------------------------------------------------------------ + subroutine write_ncfile_real2d(filename,varname,var,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + real, intent(inout) :: var(nlon,nlat) + + character(len=4) :: subname="write" + integer :: ncid, varid, omode + + call check_ret(nf_open(filename, nf_write, ncid), subname) + call check_ret(nf_set_fill(ncid, nf_nofill, omode), subname) + call ncd_ioglobal(varname=varname, data=var, ncid=ncid, flag='write') + call check_ret(nf_sync(ncid), subname) + call check_ret(nf_close(ncid), subname) + end subroutine write_ncfile_real2d +!------------------------------------------------------------------------------------------ + subroutine write_ncfile_double2d(filename,varname,var,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + real*8, intent(inout) :: var(nlon,nlat) + + character(len=4) :: subname="write" + integer :: ncid, varid, omode + + call check_ret(nf_open(filename, nf_write, ncid), subname) + call check_ret(nf_set_fill(ncid, nf_nofill, omode), subname) + call ncd_ioglobal(varname=varname, data=var, ncid=ncid, flag='write') + call check_ret(nf_sync(ncid), subname) + call check_ret(nf_close(ncid), subname) + end subroutine write_ncfile_double2d +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_int2d(filename,varname,var,lon,lat,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + integer, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int, dim1name='lon', & + dim2name='lat', long_name=varname, units='unitless', fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_int2d + + subroutine create_ncfile_int2d_fill(filename,varname,var,lon,lat,nlon,nlat,fillvalue) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + integer, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + real,intent(in) :: fillvalue + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int, dim1name='lon', & + dim2name='lat', long_name=varname, units='unitless', fill_value=fillvalue) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_int2d_fill + + subroutine create_ncfile_long2d(filename,varname,var,lon,lat,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + integer*8, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), NF_NETCDF4, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon',& + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat',& + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int64, dim1name='lon',& + dim2name='lat', long_name=varname, units='unitless',fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_long2d + +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_byte2d(filename,varname,var,lon,lat,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + byte, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_byte, dim1name='lon', & + dim2name='lat', long_name=varname, units='unitless',fill_value=-128. ) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_byte2d + +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_short2d(filename,varname,var,lon,lat,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + integer*2, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_short, dim1name='lon', & + dim2name='lat', long_name=varname, units='unitless',fill_value=-9999. ) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_short2d + + +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_real2d(filename,varname,var,lon,lat,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + real, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_float, dim1name='lon', & + dim2name='lat', long_name=varname, units='unitless', fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_real2d + +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_short3d(filename,varname,var,lon,lat,lev,nlon,nlat,nlev) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat, nlev + integer*2, intent(inout) :: var(nlon,nlat,nlev) + real*8, intent(in) :: lon(nlon),lat(nlat),lev(nlev) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat), lev1(nlev) + + lon1=lon + lat1=lat + lev1=lev + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call check_ret(nf_def_dim(ncid,'lev',nlev, dimid), subname) + + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='lev', xtype=nf_double, dim2name='lev', & + long_name='level', units='unitless') + + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_short, dim1name='lon', & + dim2name='lat', dim3name='lev', long_name=varname, units='unitless', fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lev', data=lev1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_short3d +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_int3d(filename,varname,var,lon,lat,lev,nlon,nlat,nlev) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat, nlev + integer, intent(inout) :: var(nlon,nlat,nlev) + real*8, intent(in) :: lon(nlon),lat(nlat),lev(nlev) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat), lev1(nlev) + + lon1=lon + lat1=lat + lev1=lev + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call check_ret(nf_def_dim(ncid,'lev',nlev, dimid), subname) + + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='lev', xtype=nf_double, dim2name='lev', & + long_name='level', units='unitless') + + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int, dim1name='lon', & + dim2name='lat', dim3name='lev', long_name=varname, units='unitless', fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lev', data=lev1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_int3d +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_real3d(filename,varname,var,lon,lat,lev,nlon,nlat,nlev) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat, nlev + real, intent(inout) :: var(nlon,nlat,nlev) + real*8, intent(in) :: lon(nlon),lat(nlat),lev(nlev) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat), lev1(nlev) + + lon1=lon + lat1=lat + lev1=lev + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call check_ret(nf_def_dim(ncid,'lev',nlev, dimid), subname) + + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='lev', xtype=nf_double, dim2name='lev', & + long_name='level', units='unitless') + + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_float, dim1name='lon', & + dim2name='lat', dim3name='lev', long_name=varname, units='unitless', fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lev', data=lev1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_real3d + +!------------------------------------------------------------------------------------------ + subroutine create_ncfile_double2d(filename,varname,var,lon,lat,nlon,nlat) + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + integer, intent(in) :: nlon, nlat + real*8, intent(inout) :: var(nlon,nlat) + real*8, intent(in) :: lon(nlon),lat(nlat) + + character(len=4) :: subname="create" + integer :: ncid, varid, dimid + real*8 :: lon1(nlon), lat1(nlat) + + lon1=lon + lat1=lat + call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) + call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) + call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) + call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & + long_name='longtitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & + long_name='latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_double, dim1name='lon', & + dim2name='lat', long_name=varname, units='unitless', fill_value=-9999.) + call check_ret(nf_enddef(ncid), subname) + call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) + call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) + call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) + call check_ret(nf_close(ncid), subname) + end subroutine create_ncfile_double2d +!------------------------------------------------------------------------------------------ +end module rwncfile + From 562383d93d79441fadcf0966b7df91dca933c633 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 26 Sep 2023 15:59:40 -0400 Subject: [PATCH 02/55] update some scripts --- .../Utils/Raster/preproc/routing/build | 12 ----------- .../preproc/routing/read_riveroutlet.f90 | 2 +- .../Utils/Raster/preproc/routing/run.sh | 20 ++++++++++++++++--- 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build index 5914bf200..35fe7f277 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build @@ -10,22 +10,10 @@ array=(${string//./ }) FILENAME=${array[0]} -#source /opt/intel/oneapi/setvars.sh - -#module load intel_compilers/19.0.5 -#module load intel_compilers/2021.3.0 - -#NETCDF_PATH=/usr/local/netcdf-4.2_optimized - -#NETCDF_PATH=/Users/zsp/opt/anaconda3/envs/ -#NETCDF_PATH=/usr/local/Cellar/netcdf-fortran/4.6.0 -#NETCDF_PATH=/usr/local/Cellar/netcdf/4.9.0 -#NETCDF_PATH=/Users/zsp/apps/netcdf-4.2.1.1 NETCDF_PATH=/discover/nobackup/yzeng3/apps/netcdf-4.2.1.1 ifort -qopenmp ncdioMod.f90 rwncMod.f90 ${FILENAME}.f90 -I$NETCDF_PATH/include -L$NETCDF_PATH/lib -L/usr/local/intel/oneapi/2021/compiler/2021.4.0/linux/lib -lnetcdf -lnetcdff -o ${FILENAME}.out -#ifort -O3 -m64 ${FILENAME}.f90 -I$NETCDF_PATH/include -L$NETCDF_PATH/lib -o ${FILENAME}.out diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 index 2d93bef6d..4586530b3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet.f90 @@ -17,7 +17,7 @@ program main call read_ncfile_int2d("outputs/"//trim(lonfile),"data",lons,nx,ny) -open(30,file="outlet_file/Outlet_latlon.43200x21600",form="unformatted") +open(30,file="Outlet_latlon.43200x21600",form="unformatted") do j = 1, ny diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh index 0cf16eeb6..746c4dab0 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh @@ -1,6 +1,16 @@ #!/bin/bash set -e +INPUT=/discover/nobackup/yzeng3/work/outlets/inputs + +module load comp/intel/2021.3.0 +module load ncl + +mkdir -p inputs outputs +cd inputs +ln -s ${INPUT}/* . +cd .. + echo "Building get_outlets_land.f90 ..." ./build get_outlets_land.f90 echo "Building get_mask_MAPL_2d.f90 ..." @@ -20,6 +30,7 @@ echo "Building Pfaf_to_2d_30s.f90 ..." echo "Building read_riveroutlet.f90 ..." ./build read_riveroutlet.f90 +echo "STEP ONE:" echo "running get_outlets_catchindex.ncl" ncl get_outlets_catchindex.ncl echo "running get_outlets_land.out" @@ -27,6 +38,7 @@ echo "running get_outlets_land.out" echo "running get_sinkxy_land.ncl" ncl get_sinkxy_land.ncl +echo "STEP TWO:" echo "running get_mask_MAPL_1d.ncl" ncl get_mask_MAPL_1d.ncl echo "running get_mask_MAPL_2d.out" @@ -42,16 +54,18 @@ echo "running mv_outlets_ocean.out" echo "running get_sinkxy_ocean.ncl" ncl get_sinkxy_ocean.ncl +echo STEP THREE:"" echo "running get_outlets_ocean_allcat.out" ./get_outlets_ocean_allcat.out echo "running Pfaf_to_2d_30s.out" ./Pfaf_to_2d_30s.out echo "running read_riveroutlet.out" ./read_riveroutlet.out -echo "Outlet_latlon.43200x2160 created!" +echo "Outlet_latlon.43200x21600 created!" -echo "Removing temporary output files ..." -rm -f outputs/* +echo "Removing temporary input/output files ..." +rm -rf outputs +rm -rf inputs echo "Removing *.out files ..." rm -f *.out rm -f *.mod From a69c57d04a5f9215cd8970bb673e431d3ba625f7 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 3 Oct 2023 13:56:31 -0400 Subject: [PATCH 03/55] improved run.sh --- .../Utils/Raster/preproc/routing/run.sh | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh index 746c4dab0..5b907c377 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh @@ -6,10 +6,14 @@ INPUT=/discover/nobackup/yzeng3/work/outlets/inputs module load comp/intel/2021.3.0 module load ncl +rm -rf inputs >& /dev/null +rm -rf outputs >& /dev/null +rm -f *.mod >& /dev/null +rm -f *.out >& /dev/null +rm -f Outlet_latlon.43200x21600 >& /dev/null + mkdir -p inputs outputs -cd inputs -ln -s ${INPUT}/* . -cd .. +ln -s ${INPUT}/* inputs echo "Building get_outlets_land.f90 ..." ./build get_outlets_land.f90 From e29ab36a6f9451cf23829bfb6220240687efe9d7 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 3 Oct 2023 15:59:44 -0400 Subject: [PATCH 04/55] improved code to make all inputs are raw files --- .../Raster/preproc/routing/Pfaf_to_2d_30s.f90 | 6 +- ...landocean_Greenland_real_TM0072xTM0036.f90 | 66 +++++++++++++++++++ .../routing/get_mask_TM0072xTM0036.f90 | 8 +-- .../Utils/Raster/preproc/routing/run.sh | 4 ++ 4 files changed, 77 insertions(+), 7 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 index 7a577ce6d..155022964 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 @@ -21,9 +21,9 @@ program main allocate(catchind(nlon,nlat),data2d(nlon,nlat)) allocate(lon(nlon),lat(nlat)) -call read_ncfile_double1d("inputs/"//trim(map),"lon",lon,nlon) -call read_ncfile_double1d("inputs/"//trim(map),"lat",lat,nlat) -call read_ncfile_int2d("inputs/"//trim(map),"data",catchind,nlon,nlat) +call read_ncfile_double1d("outputs/"//trim(map),"lon",lon,nlon) +call read_ncfile_double1d("outputs/"//trim(map),"lat",lat,nlat) +call read_ncfile_int2d("outputs/"//trim(map),"data",catchind,nlon,nlat) allocate(data_Pfaf(nc)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 new file mode 100755 index 000000000..5773029c5 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 @@ -0,0 +1,66 @@ +program main + +use omp_lib +use rwncfile +implicit none + +integer,parameter :: nc=291809 +integer,parameter :: nlon=43200 +integer,parameter :: nlat=21600 +integer,parameter :: nlon_G=8400 +integer,parameter :: nlat_G=4800 +integer,parameter :: loni_min=12001 +integer,parameter :: loni_max=20400 +integer,parameter :: lati_min=16801 +integer,parameter :: lati_max=21600 + +integer,parameter :: id_glac=286926 +integer,parameter :: id_lake=286925 +integer,parameter :: id_landend=284954 + +real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G +integer,allocatable,dimension(:,:) :: landocean,Greenland +integer,allocatable,dimension(:) :: Pfaf_real, countc + +integer :: i,j + +allocate(landocean(nlon,nlat)) +allocate(lon(nlon),lat(nlat)) +call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter.nc","lon",lon,nlon) +call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter.nc","lat",lat,nlat) +call read_ncfile_int2d("inputs/TM0072xTM0036-Pfafstetter.nc","data",landocean,nlon,nlat) + +allocate(Greenland(nlon_G,nlat_G)) +allocate(lon_G(nlon_G),lat_G(nlat_G)) +call read_ncfile_double1d("inputs/GreenlandID_30s.nc","lon",lon_G,nlon_G) +call read_ncfile_double1d("inputs/GreenlandID_30s.nc","lat",lat_G,nlat_G) +call read_ncfile_int2d("inputs/GreenlandID_30s.nc","data",Greenland,nlon_G,nlat_G) + +where(Greenland/=-9999.and.(landocean(loni_min:loni_max,lati_min:lati_max)<=id_landend.or.& + landocean(loni_min:loni_max,lati_min:lati_max)==id_glac ))& + landocean(loni_min:loni_max,lati_min:lati_max)=Greenland + + +where(landocean>id_landend.and.landocean=1)then + landocean(i,j)=Pfaf_real(landocean(i,j)) + else if(landocean(i,j)>=700000000)then + landocean(i,j)=landocean(i,j)-700000000+291284 + endif + enddo +enddo + + + +call create_ncfile_int2d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","data",landocean,lon,lat,nlon,nlat) + + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 index be081341c..d9c8923a7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 @@ -13,9 +13,9 @@ program main allocate(mask_mapl(nlon,nlat),mask_rst(nlon,nlat),lon(nlon),lat(nlat),mask(nlon,nlat)) -call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lon",lon,nlon) -call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lat",lat,nlat) -call read_ncfile_int2d("inputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","data",mask_rst,nlon,nlat) +call read_ncfile_double1d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lon",lon,nlon) +call read_ncfile_double1d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lat",lat,nlat) +call read_ncfile_int2d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","data",mask_rst,nlon,nlat) call read_ncfile_int2d("outputs/mask_MAPL_TM0072xTM0036.nc","data",mask_mapl,nlon,nlat) @@ -26,4 +26,4 @@ program main -end \ No newline at end of file +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh index 5b907c377..4c5a1cdf9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh @@ -17,6 +17,8 @@ ln -s ${INPUT}/* inputs echo "Building get_outlets_land.f90 ..." ./build get_outlets_land.f90 +echo "Building get_landocean_Greenland_real_TM0072xTM0036.f90 ..." +./build get_landocean_Greenland_real_TM0072xTM0036.f90 echo "Building get_mask_MAPL_2d.f90 ..." ./build get_mask_MAPL_2d.f90 echo "Building get_mask_TM0072xTM0036.f90 ..." @@ -43,6 +45,8 @@ echo "running get_sinkxy_land.ncl" ncl get_sinkxy_land.ncl echo "STEP TWO:" +echo "running get_landocean_Greenland_real_TM0072xTM0036.out" +./get_landocean_Greenland_real_TM0072xTM0036.out echo "running get_mask_MAPL_1d.ncl" ncl get_mask_MAPL_1d.ncl echo "running get_mask_MAPL_2d.out" From ebfef8539229c6f10e0463995ffb202bf14894b7 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 6 Oct 2023 09:41:50 -0400 Subject: [PATCH 05/55] re-write all ncl code to f90 code. --- .../preproc/routing/get_mask_MAPL_1d.f90 | 32 ++++++++++++ .../preproc/routing/get_mask_MAPL_1d.ncl | 20 ------- .../routing/get_outlets_catchindex.f90 | 52 +++++++++++++++++++ .../routing/get_outlets_catchindex.ncl | 33 ------------ .../preproc/routing/get_sinkxy_land.f90 | 46 ++++++++++++++++ .../preproc/routing/get_sinkxy_land.ncl | 19 ------- .../preproc/routing/get_sinkxy_ocean.f90 | 46 ++++++++++++++++ .../preproc/routing/get_sinkxy_ocean.ncl | 19 ------- .../Utils/Raster/preproc/routing/run.sh | 33 +++++++----- 9 files changed, 197 insertions(+), 103 deletions(-) create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl create mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 new file mode 100755 index 000000000..eb9cf232d --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 @@ -0,0 +1,32 @@ +program main + +use rwncfile +implicit none + +integer,parameter :: nt=2592 +integer,parameter :: nlon=72 +integer,parameter :: nlat=36 + +real,allocatable,dimension(:,:) :: msk_MAPL +integer,allocatable,dimension(:) :: t2lati,t2loni,msk_tile + +integer :: i + +allocate(msk_MAPL(nlon,nlat)) +allocate(t2lati(nt),t2loni(nt),msk_tile(nt)) +call read_ncfile_real2d("inputs/MAPL_Tripolar.nc","mask",msk_MAPL,nlon,nlat) +open(77,file="inputs/TM0072xTM0036_tile_to_MAPL_lati.txt") +read(77,*)t2lati +open(77,file="inputs/TM0072xTM0036_tile_to_MAPL_loni.txt") +read(77,*)t2loni + +do i=1,nt + msk_tile(i)=int(msk_MAPL(t2loni(i),t2lati(i))) +enddo + +open(88,file="outputs/mask_MAPL_1d_TM0072xTM0036.txt") +do i=1,nt + write(88,*)msk_tile(i) +enddo + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl deleted file mode 100755 index 4382e44d2..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.ncl +++ /dev/null @@ -1,20 +0,0 @@ -begin - -nt=2592 - -f=addfile("inputs/MAPL_Tripolar.nc","r") -msk_MAPL=f->mask - -t2lati=asciiread("inputs/TM0072xTM0036_tile_to_MAPL_lati.txt",nt,"integer") -t2loni=asciiread("inputs/TM0072xTM0036_tile_to_MAPL_loni.txt",nt,"integer") - -msk_tile=new(nt,integer) -msk_tile=msk_tile -do i=0,nt-1 - msk_tile(i)=toint(msk_MAPL(t2lati(i)-1,t2loni(i)-1)) -end do - -asciiwrite("outputs/mask_MAPL_1d_TM0072xTM0036.txt",msk_tile) - - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 new file mode 100755 index 000000000..04ee53ec0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 @@ -0,0 +1,52 @@ +program main + +implicit none + +integer,parameter :: nc=291284 +integer,parameter :: ns=22612 +integer,parameter :: ng=525 + +integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall + +integer :: k,i,ntot + +ntot=nc+ng +allocate(msk(nc),outid(ns),mskall(ntot),final(nc),finalall(ntot)) +open(77,file="inputs/Pfaf_msk.txt") +read(77,*)msk +k=0 +do i=1,nc + if(msk(i).eq.2)then + k=k+1 + outid(k)=i + end if +end do +do i=k+1,ns + outid(i)=nc+i-k +end do +open(88,file="outputs/outlet_catchindex.txt") +do i=1,ns + write(88,*)outid(i) +enddo + +mskall(1:nc)=msk +mskall(nc+1:)=2 +open(88,file="outputs/Pfaf_msk_all.txt") +do i=1,ntot + write(88,*)mskall(i) +enddo + +open(77,file="inputs/Pfaf_finalID.txt") +read(77,*)final +finalall(1:nc)=final +do i=nc+1,ntot + finalall(i)=i +end do +open(88,file="outputs/Pfaf_finalID_all.txt") +do i=1,ntot + write(88,*)finalall(i) +enddo + + + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl deleted file mode 100755 index 93d00248b..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.ncl +++ /dev/null @@ -1,33 +0,0 @@ -begin -nc=291284 -ns=22612 -ng=525 - -msk=asciiread("inputs/Pfaf_msk.txt",nc,"integer") -outid=new(ns,integer) -k=0 -do i=0,nc-1 - if(msk(i).eq.2)then - outid(k)=i+1 - k=k+1 - end if -end do -do i=k,ns-1 - outid(i)=nc+i-k+1 -end do -asciiwrite("outputs/outlet_catchindex.txt",outid) - -mskall=new(nc+ng,integer) -mskall(0:nc-1)=msk -mskall(nc:)=2 -asciiwrite("outputs/Pfaf_msk_all.txt",mskall) - -final=asciiread("inputs/Pfaf_finalID.txt",nc,"integer") -finalall=new(nc+ng,integer) -finalall(0:nc-1)=final -do i=nc,nc+ng-1 - finalall(i)=i+1 -end do -asciiwrite("outputs/Pfaf_finalID_all.txt",finalall) - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 new file mode 100755 index 000000000..e2f9d33d3 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -0,0 +1,46 @@ +program main + +use rwncfile +implicit none + +integer,parameter :: ns=22612 +integer,parameter :: nlat=21600 +integer,parameter :: nlon=43200 + +real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis +integer,allocatable,dimension(:) :: lati,loni + +integer :: i,temp(1) + +allocate(lats(ns),lons(ns),lati(ns),loni(ns)) +allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) +open(77,file="outputs/outlet_sinklat.txt") +read(77,*)lats +open(77,file="outputs/outlet_sinklon.txt") +read(77,*)lons +open(77,file="inputs/lat_30s.txt") +read(77,*)lat30s +open(77,file="inputs/lon_30s.txt") +read(77,*)lon30s + +do i=1,ns + lat_dis=abs(lat30s-lats(i)) + temp=minloc(lat_dis) + lati(i)=temp(1) +enddo +do i=1,ns + lon_dis=abs(lon30s-lons(i)) + temp=minloc(lon_dis) + loni(i)=temp(1) +enddo + +open(88,file="outputs/outlet_sinky.txt") +do i=1,ns + write(88,*)lati(i) +enddo +open(88,file="outputs/outlet_sinkx.txt") +do i=1,ns + write(88,*)loni(i) +enddo + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl deleted file mode 100755 index 22b32627e..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.ncl +++ /dev/null @@ -1,19 +0,0 @@ -begin - -ns=22612 -nlat=21600 -nlon=43200 - -lat=asciiread("outputs/outlet_sinklat.txt",ns,"double") -lon=asciiread("outputs/outlet_sinklon.txt",ns,"double") - -lat30s=asciiread("inputs/lat_30s.txt",nlat,"double") -lon30s=asciiread("inputs/lon_30s.txt",nlon,"double") - -lati=ind_nearest_coord(lat,lat30s,0) -loni=ind_nearest_coord(lon,lon30s,0) - -asciiwrite("outputs/outlet_sinky.txt",lati+1) -asciiwrite("outputs/outlet_sinkx.txt",loni+1) - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 new file mode 100755 index 000000000..2412a0af0 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 @@ -0,0 +1,46 @@ +program main + +use rwncfile +implicit none + +integer,parameter :: ns=22612 +integer,parameter :: nlat=21600 +integer,parameter :: nlon=43200 + +real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis +integer,allocatable,dimension(:) :: lati,loni + +integer :: i,temp(1) + +allocate(lats(ns),lons(ns),lati(ns),loni(ns)) +allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) +open(77,file="outputs/outlet_sinklat_TM0072xTM0036_mask.txt") +read(77,*)lats +open(77,file="outputs/outlet_sinklon_TM0072xTM0036_mask.txt") +read(77,*)lons +open(77,file="inputs/lat_30s.txt") +read(77,*)lat30s +open(77,file="inputs/lon_30s.txt") +read(77,*)lon30s + +do i=1,ns + lat_dis=abs(lat30s-lats(i)) + temp=minloc(lat_dis) + lati(i)=temp(1) +enddo +do i=1,ns + lon_dis=abs(lon30s-lons(i)) + temp=minloc(lon_dis) + loni(i)=temp(1) +enddo + +open(88,file="outputs/outlet_sinky_TM0072xTM0036_mask.txt") +do i=1,ns + write(88,*)lati(i) +enddo +open(88,file="outputs/outlet_sinkx_TM0072xTM0036_mask.txt") +do i=1,ns + write(88,*)loni(i) +enddo + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl deleted file mode 100755 index 33d1e7d53..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.ncl +++ /dev/null @@ -1,19 +0,0 @@ -begin - -ns=22612 -nlat=21600 -nlon=43200 - -lat=asciiread("outputs/outlet_sinklat_TM0072xTM0036_mask.txt",ns,"double") -lon=asciiread("outputs/outlet_sinklon_TM0072xTM0036_mask.txt",ns,"double") - -lat30s=asciiread("inputs/lat_30s.txt",nlat,"double") -lon30s=asciiread("inputs/lon_30s.txt",nlon,"double") - -lati=ind_nearest_coord(lat,lat30s,0) -loni=ind_nearest_coord(lon,lon30s,0) - -asciiwrite("outputs/outlet_sinky_TM0072xTM0036_mask.txt",lati+1) -asciiwrite("outputs/outlet_sinkx_TM0072xTM0036_mask.txt",loni+1) - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh index 4c5a1cdf9..b4418cc80 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh @@ -4,7 +4,6 @@ set -e INPUT=/discover/nobackup/yzeng3/work/outlets/inputs module load comp/intel/2021.3.0 -module load ncl rm -rf inputs >& /dev/null rm -rf outputs >& /dev/null @@ -15,10 +14,17 @@ rm -f Outlet_latlon.43200x21600 >& /dev/null mkdir -p inputs outputs ln -s ${INPUT}/* inputs +echo "Building get_outlets_catchindex.f90 ..." +./build get_outlets_catchindex.f90 echo "Building get_outlets_land.f90 ..." ./build get_outlets_land.f90 +echo "Building get_sinkxy_land.f90 ..." +./build get_sinkxy_land.f90 + echo "Building get_landocean_Greenland_real_TM0072xTM0036.f90 ..." ./build get_landocean_Greenland_real_TM0072xTM0036.f90 +echo "Building get_mask_MAPL_1d.f90 ..." +./build get_mask_MAPL_1d.f90 echo "Building get_mask_MAPL_2d.f90 ..." ./build get_mask_MAPL_2d.f90 echo "Building get_mask_TM0072xTM0036.f90 ..." @@ -29,6 +35,9 @@ echo "Building get_oceanbond_points_TM0072xTM0036_mask.f90 ..." ./build get_oceanbond_points_TM0072xTM0036_mask.f90 echo "Building mv_outlets_ocean.f90 ..." ./build mv_outlets_ocean.f90 +echo "Building get_sinkxy_ocean.f90 ..." +./build get_sinkxy_ocean.f90 + echo "Building get_outlets_ocean_allcat.f90 ..." ./build get_outlets_ocean_allcat.f90 echo "Building Pfaf_to_2d_30s.f90 ..." @@ -36,19 +45,19 @@ echo "Building Pfaf_to_2d_30s.f90 ..." echo "Building read_riveroutlet.f90 ..." ./build read_riveroutlet.f90 -echo "STEP ONE:" -echo "running get_outlets_catchindex.ncl" -ncl get_outlets_catchindex.ncl +echo "STEP ONE: Getting the outlet locations in land" +echo "running get_outlets_catchindex.out" +./get_outlets_catchindex.out echo "running get_outlets_land.out" ./get_outlets_land.out -echo "running get_sinkxy_land.ncl" -ncl get_sinkxy_land.ncl +echo "running get_sinkxy_land.out" +./get_sinkxy_land.out -echo "STEP TWO:" +echo "STEP TWO: Moving the outlet locations to ocean" echo "running get_landocean_Greenland_real_TM0072xTM0036.out" ./get_landocean_Greenland_real_TM0072xTM0036.out -echo "running get_mask_MAPL_1d.ncl" -ncl get_mask_MAPL_1d.ncl +echo "running get_mask_MAPL_1d.out" +./get_mask_MAPL_1d.out echo "running get_mask_MAPL_2d.out" ./get_mask_MAPL_2d.out echo "running get_mask_TM0072xTM0036.out" @@ -59,10 +68,10 @@ echo "running get_oceanbond_points_TM0072xTM0036_mask.out" ./get_oceanbond_points_TM0072xTM0036_mask.out echo "running mv_outlets_ocean.out" ./mv_outlets_ocean.out -echo "running get_sinkxy_ocean.ncl" -ncl get_sinkxy_ocean.ncl +echo "running get_sinkxy_ocean.out" +./get_sinkxy_ocean.out -echo STEP THREE:"" +echo "STEP THREE: Finalizing the outlet files for use in the mk_bcs output" echo "running get_outlets_ocean_allcat.out" ./get_outlets_ocean_allcat.out echo "running Pfaf_to_2d_30s.out" From 6cdae0b4f83ef1fa039217f5c8dee573a396ebc3 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Thu, 12 Oct 2023 10:39:08 -0400 Subject: [PATCH 06/55] change mk_runofftbl.F90 to include the feature of moving outlets to ocean defined in the ocean model. Now the default adjust_oceanLandSea_mask is set to true. --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 612 +++++++++++++++++- 1 file changed, 602 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 298895f5c..67feafdcf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -5,6 +5,7 @@ program Runoff use netcdf implicit none + include 'netcdf.inc' integer :: nx, ny, pf integer, allocatable :: lats(:,:), lons(:,:) @@ -23,7 +24,7 @@ program Runoff character*5 :: C_NX, C_NY - logical :: adjust_oceanLandSea_mask = .false. ! default is .false. + logical :: adjust_oceanLandSea_mask = .true. ! default is .true. integer :: nxt, command_argument_count character*(128) :: arg, & Usage = "mk_runofftbl.x CF0012x6C_TM0072xTM0036-Pfafstetter", & @@ -54,13 +55,16 @@ program Runoff if (I > 1) then nxt = nxt + 1 call get_command_argument(nxt, arg) - if ( trim(arg) .ne. 'yes') then - print *, "Incorrect optional second argument, should be: yes" - call exit(2) - else - adjust_oceanLandSea_mask = .true. - nxt = nxt + 1 - call get_command_argument(nxt, mapl_tp_file) + !if ( trim(arg) .ne. 'yes') then + ! print *, "Incorrect optional second argument, should be: yes" + ! call exit(2) + !else + ! adjust_oceanLandSea_mask = .true. + ! nxt = nxt + 1 + ! call get_command_argument(nxt, mapl_tp_file) + !endif + if ( trim(arg) .eq. 'no') then + adjust_oceanLandSea_mask = .false. endif endif ! ------------------------------------------------------------------ @@ -136,7 +140,8 @@ program Runoff print *, "- Of GEOS land and external ocean model." print *, "- Output file: ", fileB print *, " " - call read_oceanModel_mask( mapl_tp_file) +! call read_oceanModel_mask( mapl_tp_file) + call outlets_to_ocean(file,lons,lats,nx,ny) ! ... some adjustment of following variable: `type` ! ... using ocean model land-sea mask should be done here endif @@ -394,6 +399,593 @@ subroutine check(status) stop end if end subroutine check -! ----------------------------------------------------------------- +!------------------------------------------------------------------------ +subroutine outlets_to_ocean(file,lons,lats,nx,ny) + + integer, intent(in) :: nx,ny + character(len=*) :: file + integer,intent(inout) :: lons(nx,ny),lats(nx,ny) + + integer,allocatable,dimension(:) :: lati_lnd,loni_lnd + integer,allocatable,dimension(:) :: msk1d + integer,allocatable,dimension(:,:) :: msk2d + integer,allocatable,dimension(:,:) :: mask + integer,allocatable,dimension(:,:) :: boundary + real*8, allocatable,dimension(:) :: lonsh,latsh + real*8,allocatable,dimension(:) :: lons_adj,lats_adj + integer,allocatable,dimension(:) :: lati_ocn,loni_ocn + character*100 :: file_ocn + character*100 :: fileT_ocn, fileR_ocn + character*100 :: file_ocn_lnd + character*100 :: fileT_ocn_lnd, fileR_ocn_lnd + character*100 :: res_MAPL + integer, allocatable,dimension(:,:) :: rst_ocn,rst_ocn_lnd + real :: num1,num2,num3,num4 + integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh + integer, allocatable,dimension(:) :: t2lati,t2loni + real*8,allocatable,dimension(:) :: lon30s,lat30s + real*8 :: dx,dy + integer :: ns + integer,allocatable,dimension(:,:) :: ns_map + real*8,allocatable,dimension(:) :: lat_lnd,lon_lnd + + integer :: i,j,l,k,status,type,np + + do i=1,100 + if(file(i:i).eq."T".and.file(i+1:i+1).eq."M")then + exit + endif + enddo + file_ocn="" + file_ocn(1:13)=file(i:i+12) + !print *,trim(file_ocn) + file_ocn_lnd="" + file_ocn_lnd(1:13)=file_ocn + file_ocn_lnd(14:25)="-Pfafstetter" + !print *,trim(file_ocn_lnd) + + if(trim(file_ocn).eq."TM0072xTM0036")then + res_MAPL="72x36" + nx_MAPL=72 + ny_MAPL=36 + else if(trim(file_ocn).eq."TM0540xTM0458")then + res_MAPL="540x458" + nx_MAPL=540 + ny_MAPL=458 + else if(trim(file_ocn).eq."TM1440xTM1080")then + res_MAPL="1440x1080" + nx_MAPL=1440 + ny_MAPL=1080 + else + print *,"ocean resolution is not supported!" + stop + endif + + fileT_ocn = "til/"//trim(file_ocn)//".til" ! input + fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input + fileT_ocn_lnd = "til/"//trim(file_ocn_lnd)//".til" ! input + fileR_ocn_lnd = "rst/"//trim(file_ocn_lnd)//".rst" ! input + + !print *, "Reading rst file "//trim(fileR_ocn) + open(20,file=fileR_ocn,form="unformatted",status="old") + allocate(rst_ocn(nx,ny),stat=status) + if(status/=0) then + print *, "Out of Memory" + stop + endif + do j=1,ny + read(20) rst_ocn(:,j) + enddo + close(20) + + !print *, "Reading rst file "//trim(fileR_ocn_lnd) + open(21,file=fileR_ocn_lnd,form="unformatted",status="old") + allocate(rst_ocn_lnd(nx,ny),stat=status) + if(status/=0) then + print *, "Out of Memory" + stop + endif + do j=1,ny + read(21) rst_ocn_lnd(:,j) + enddo + close(21) + + open(10,file=fileT_ocn, form="formatted", status="old") + read(10,*) nt_ocn + allocate(t2lati(nt_ocn),t2loni(nt_ocn)) + do i=1,4 + read(10,*) + enddo + do l=1,nt_ocn + read(10,*)type,num1,num2,num3,t2loni(l),t2lati(l) + enddo + close(10) + + open(10,file=fileT_ocn_lnd, form="formatted", status="old") + read(10,*) np + do i=1,4 + read(10,*) + enddo + k=0 + do l=1,np + read(10,*)type,num1,num2,num3,num4 + if(type/=100)exit + k=k+1 + enddo + close(10) + nt_ocn_lnd=np + nl_ocn_lnd=k + + + allocate(lon30s(nx),lat30s(ny)) + dx=360.d0/nx + dy=180.d0/ny + do i=1,nx + lon30s(i)=-180.d0+dx/2.d0+dx*(i-1) + enddo + do j=1,ny + lat30s(j)=-90.d0+dy/2.d0+dy*(j-1) + enddo + + !print *,"running outlets_num() ..." + call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) + !print *,"outlets num is ",ns + allocate(loni_lnd(ns),lati_lnd(ns)) + allocate(msk1d(nt_ocn)) + allocate(msk2d(nx,ny)) + allocate(mask(nx,ny)) + allocate(boundary(nx,ny)) + allocate(lons_adj(ns),lats_adj(ns)) + allocate(loni_ocn(ns),lati_ocn(ns)) + allocate(ns_map(nx,ny)) + allocate(lon_lnd(ns),lat_lnd(ns)) + !print *,"running retrieve_outlets() ..." + call retrieve_outlets(lons,lats,lon30s,lat30s,loni_lnd,lati_lnd,lon_lnd,lat_lnd,ns_map,nx,ny,ns) + !print *,"running mask_MAPL_1d() ..." + call mask_MAPL_1d(msk1d,t2loni,t2lati,nt_ocn,res_MAPL,nx_MAPL,ny_MAPL) + !print *,"running mask_MAPL_2d() ..." + call mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt_ocn,nx,ny) + !print *,"running mask_MAPL_bcs() ..." + call mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nx,ny,nl_ocn_lnd,nt_ocn_lnd) + !print *,"running ocean_boundary() ..." + call ocean_boundary(mask,boundary,nx,ny) + !print *,"running ocean_boundary_num() ..." + call ocean_boundary_num(boundary,nx,ny,nsh) + !print *,"ocean boundary point num is ",nsh + allocate(lonsh(nsh),latsh(nsh)) + !print *,"running ocean_boundary_points() ..." + call ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nx,ny,nsh) + !print *,"running move_to_ocean() ..." + call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) + !print *,"running sinkxy_ocean() ..." + call sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni_ocn,lati_ocn,ns,nx,ny) + !print *,"running update_outlets() ..." + call update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) + + deallocate(loni_lnd,lati_lnd,msk1d,msk2d,mask,& + boundary,lonsh,latsh,lons_adj,lats_adj,loni_ocn,lati_ocn) + deallocate(rst_ocn,lat30s,lon30s) + deallocate(ns_map,lon_lnd,lat_lnd) + deallocate(rst_ocn_lnd) + +end subroutine outlets_to_ocean +!------------------------------------------------------------------------- +subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) + +integer,intent(in) :: nx,ny,nl,nt +integer,intent(inout) :: lons(nx,ny),lats(nx,ny) +integer,intent(in) :: rst_ocn_lnd(nx,ny) +integer,intent(out) :: ns + +integer,allocatable,dimension(:) :: lonp,latp +integer,allocatable,dimension(:,:) :: acc,np_map + +integer :: i,j,k,l,lonc,latc,flag,maxbak,status,num + +!print *,"running outlets_num() ..." + +allocate(acc(nx,ny)) + +do i=1,nx + do j=1,ny + if(rst_ocn_lnd(i,j)>nl.and.rst_ocn_lnd(i,j)/=nt)then + lons(i,j)=-999 + lats(i,j)=-999 + endif + enddo +enddo + +acc=0 +k=0 +do i=1,nx + do j=1,ny + if(lons(i,j)/=-999.and.lats(i,j)/=-999)then + lonc=lons(i,j) + latc=lats(i,j) + if(acc(lonc,latc)==0)then + k=k+1 + acc(lonc,latc)=1 + else + acc(lonc,latc)=acc(lonc,latc)+1 + endif + endif + enddo +enddo +ns=k +deallocate(acc) +end subroutine outlets_num +!------------------------------------------------------------------------ +subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns_map,nx,ny,ns) + +integer,intent(in) :: nx,ny,ns +integer,intent(in) :: lons(nx,ny),lats(nx,ny) +real*8,intent(in) :: lon30s(nx),lat30s(ny) +integer,intent(out) :: lonp(ns),latp(ns) +real*8,intent(out) :: lon_lnd(ns),lat_lnd(ns) +integer,intent(out) :: ns_map(nx,ny) + + +integer,allocatable,dimension(:,:) :: acc + +integer :: i,j,k,l,lonc,latc + +!print *,"running retrieve_outlets() ..." + +allocate(acc(nx,ny)) +ns_map=-9999 +acc=0 +k=0 +do i=1,nx + do j=1,ny + if(lons(i,j)/=-999.and.lats(i,j)/=-999)then + lonc=lons(i,j) + latc=lats(i,j) + if(acc(lonc,latc)==0)then + k=k+1 + acc(lonc,latc)=1 + lonp(k)=lonc + latp(k)=latc + ns_map(lonc,latc)=k + else + acc(lonc,latc)=acc(lonc,latc)+1 + endif + endif + enddo +enddo + +do i=1,ns + lon_lnd(i)=lon30s(lonp(i)) + lat_lnd(i)=lat30s(latp(i)) +enddo + +deallocate(acc) + +end subroutine retrieve_outlets +!------------------------------------------------------------------------ +subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) + +integer,intent(in) :: nt,nlon,nlat +integer,intent(in) :: t2loni(nt),t2lati(nt) +character(len=*) :: res_MAPL +integer,intent(out) :: msk_tile(nt) + + +real,allocatable,dimension(:,:) :: msk_MAPL + +integer :: i + +!print *,"running mask_MAPL_1d() ..." + +allocate(msk_MAPL(nlon,nlat)) +call read_oceanModel_mapl("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ocean/MOM6/"//trim(res_MAPL)//"/MAPL_Tripolar.nc",msk_MAPL,nlon,nlat) + +do i=1,nt + msk_tile(i)=int(msk_MAPL(t2loni(i),t2lati(i))) +enddo + +deallocate(msk_MAPL) + +end subroutine mask_MAPL_1d +!------------------------------------------------------------------------ + subroutine read_oceanModel_mapl(mask_file,wetMask,nx,ny) + implicit none + character(len=*), intent(in) :: mask_file + integer,intent(in) :: nx, ny + real :: wetMask(nx,ny) + + integer :: ncid, varid + character(len=4) :: subname="read" + + !print *, "Reading ocean model mask from : ", mask_file + + call check_ret(nf_open(mask_file,0,ncid),subname) + call check_ret(nf_inq_varid(ncid,"mask",varid),subname) + call check_ret(nf_get_var_real(ncid,varid,wetMask),subname) + call check_ret(nf_close(ncid), subname) + + end subroutine read_oceanModel_mapl +!------------------------------------------------------------------------ + subroutine check_ret(ret, calling) + implicit none + integer, intent(in) :: ret + character(len=*) :: calling + + if (ret /= NF_NOERR) then !脠莽鹿没麓貌驴陋nc脦脛录镁鲁枚麓铆拢卢脭貌脤谩脢戮鲁枚麓铆脨脜脧垄 + write(6,*)'netcdf error from ',trim(calling) + call endrun(nf_strerror(ret)) + end if + + end subroutine check_ret +!----------------------------------------------------------------------- +subroutine endrun(msg,subname) + + implicit none + character(len=*), intent(in), optional :: msg ! string to be printed + character(len=*), intent(in), optional :: subname ! subname + + if (present (subname)) then + write(6,*) 'ERROR in subroutine :', trim(subname) + end if + + if (present (msg)) then + write(6,*)'ENDRUN:', msg + else + write(6,*) 'ENDRUN: called without a message string' + end if + + stop +end subroutine endrun +!------------------------------------------------------------------------ +subroutine mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt,nlon,nlat) + +integer,intent(in) :: nt,nlon,nlat +integer,intent(in) :: rst_ocn(nlon,nlat) +integer,intent(in) :: msk1d(nt) +integer,intent(out) :: msk2d(nlon,nlat) + +real*8,allocatable,dimension(:) :: lon,lat +integer,allocatable,dimension(:,:) :: landocean +integer,allocatable,dimension(:) :: mask1d + +integer :: i,j,xi,yi,tid + +!print *,"running mask_MAPL_2d() ..." + +allocate(landocean(nlon,nlat)) +landocean=rst_ocn + +allocate(mask1d(nt)) +mask1d=msk1d +do i=1,nlon + do j=1,nlat + tid=landocean(i,j) + msk2d(i,j)=mask1d(tid) + enddo +enddo + +deallocate(landocean,mask1d) + +end subroutine mask_MAPL_2d +!------------------------------------------------------------------------ +subroutine mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nlon,nlat,nl,nt) + +integer,intent(in) :: nlon,nlat,nl,nt +integer,intent(in) :: rst_ocn_lnd(nlon,nlat) +integer,intent(in) :: msk2d(nlon,nlat) +integer,intent(out) :: mask(nlon,nlat) + +real*8,allocatable :: lon(:),lat(:) + +integer,allocatable,dimension(:,:) :: mask_mapl,mask_rst + +!print *,"running mask_MAPL_bcs() ..." + +allocate(mask_mapl(nlon,nlat),lon(nlon),lat(nlat)) +mask_mapl=msk2d +mask=0 +where(rst_ocn_lnd>nl.and.rst_ocn_lnd/=nt.and.rst_ocn_lnd/=nt-1.and.mask_mapl==1)mask=1 +deallocate(mask_mapl,lon,lat) + +end subroutine mask_MAPL_bcs +!------------------------------------------------------------------------ +subroutine ocean_boundary(mask,boundary,nlon,nlat) + +integer,intent(in) :: nlon,nlat +integer,intent(in) :: mask(nlon,nlat) +integer,intent(out) :: boundary(nlon,nlat) + +real*8,allocatable :: lon(:),lat(:) + +integer,allocatable :: catchind(:,:) + +integer :: xi,yi,id +integer :: xp1,xm1,yp1,ym1 + +!print *,"running ocean_boundary() ..." + +allocate(catchind(nlon,nlat),lon(nlon),lat(nlat)) +catchind=mask + +boundary=catchind +boundary=-9999 + +do xi=2,nlon-1 + do yi=2,nlat-1 + id=catchind(xi,yi) + if(id==1)then + boundary(xi,yi)=0 + if(catchind(xi+1,yi)==1.and.& + catchind(xi+1,yi-1)==1.and.& + catchind(xi ,yi-1)==1.and.& + catchind(xi-1,yi-1)==1.and.& + catchind(xi-1,yi)==1.and.& + catchind(xi-1,yi+1)==1.and.& + catchind(xi ,yi+1)==1.and.& + catchind(xi+1,yi+1)==1)then + boundary(xi,yi)=-9999 + endif + endif + enddo +enddo + +deallocate(catchind,lon,lat) + +end subroutine ocean_boundary +!------------------------------------------------------------------------ +subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) + +integer,intent(in) :: nlon,nlat +integer,intent(in) :: mskh(nlon,nlat) +integer,intent(out) :: nsh + +integer i,xi,yi,k + +!print *,"running ocean_boundary_num() ..." +k=0 +do xi=1,nlon + do yi=1,nlat + if(mskh(xi,yi)==0)then + k=k+1 + endif + enddo +enddo +nsh=k +end subroutine ocean_boundary_num +!------------------------------------------------------------------------ +subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) + +integer,intent(in) :: nlon,nlat,nsh +integer,intent(in) :: mskh(nlon,nlat) +real*8,intent(in) :: lon30s(nlon),lat30s(nlat) +real*8,intent(out) :: lonsh(nsh),latsh(nsh) +integer i,xi,yi,k + +!print *,"running ocean_boundary_points() ..." +k=0 +do xi=1,nlon + do yi=1,nlat + if(mskh(xi,yi)==0)then + k=k+1 + lonsh(k)=lon30s(xi) + latsh(k)=lat30s(yi) + endif + enddo +enddo +end subroutine ocean_boundary_points +!------------------------------------------------------------------------ +subroutine move_to_ocean(loni_lnd,lati_lnd,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) + +integer,intent(in) :: ns,nlon,nlat,nsh +integer,intent(in) :: loni_lnd(ns),lati_lnd(ns) +real*8,intent(in) :: lons(ns),lats(ns) +integer,intent(in) :: mask(nlon,nlat) +real*8,intent(in) :: lonsh(nsh),latsh(nsh) +real*8,intent(out) :: lons_adj(ns),lats_adj(ns) + +integer,allocatable :: lonsi(:),latsi(:) +integer,allocatable :: catid(:),flag(:) + +real,allocatable :: dist(:) + +integer :: i,j +real :: dy,dy2,dx,dx2,dxA,dxB,dist_temp + +!print *,"running move_to_ocean() ..." + +allocate(lonsi(ns),latsi(ns)) +allocate(catid(ns),flag(ns),dist(ns)) +lonsi=loni_lnd +latsi=lati_lnd +do i=1,ns + IF(mask(lonsi(i),latsi(i))==0)THEN + dist(i)=1.e12 + do j=1,nsh + dy=abs(lats(i)-latsh(j)) + dy2=dy*dy + dxA=abs(lons(i)-lonsh(j)) + dxB=360.-dxA + dx=min(dxA,dxB) + dx2=dx*dx + dist_temp=sqrt(dx2+dy2) + if(dist_tempns)then + print *,"ns_map is Incorrect, ind=",ind + stop + endif + lons(i,j)=loni_ocn(ind) + lats(i,j)=lati_ocn(ind) + + endif + enddo +enddo + +end subroutine update_outlets +!------------------------------------------------------------------------ end program Runoff From e84a25ed7c96081f7899f8206c8e8011bc2900f9 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Thu, 12 Oct 2023 14:53:12 -0400 Subject: [PATCH 07/55] code fixed for mask_MAPL_2d --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 67feafdcf..9123c3f51 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -736,26 +736,20 @@ subroutine endrun(msg,subname) stop end subroutine endrun !------------------------------------------------------------------------ -subroutine mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt,nlon,nlat) +subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) integer,intent(in) :: nt,nlon,nlat -integer,intent(in) :: rst_ocn(nlon,nlat) -integer,intent(in) :: msk1d(nt) +integer,intent(in) :: landocean(nlon,nlat) +integer,intent(in) :: mask1d(nt) integer,intent(out) :: msk2d(nlon,nlat) real*8,allocatable,dimension(:) :: lon,lat -integer,allocatable,dimension(:,:) :: landocean -integer,allocatable,dimension(:) :: mask1d integer :: i,j,xi,yi,tid !print *,"running mask_MAPL_2d() ..." -allocate(landocean(nlon,nlat)) -landocean=rst_ocn -allocate(mask1d(nt)) -mask1d=msk1d do i=1,nlon do j=1,nlat tid=landocean(i,j) @@ -763,7 +757,6 @@ subroutine mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt,nlon,nlat) enddo enddo -deallocate(landocean,mask1d) end subroutine mask_MAPL_2d !------------------------------------------------------------------------ From e56959a2d6b9d6e5f9a596f7f0f6d5d403a4c244 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 13 Oct 2023 15:05:38 -0400 Subject: [PATCH 08/55] cleaned up the code --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 196 ++++-------------- 1 file changed, 42 insertions(+), 154 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 9123c3f51..3f608b0a8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -16,7 +16,7 @@ program Runoff integer :: type, np,lnd, is,ie,ww integer :: numtrans, numclosed integer :: status - character*100 :: file, fileT, fileR, fileO, fileB, fileBB + character*100 :: file, fileT, fileR, fileO, fileB character*400 :: fileLL character*400 :: MAKE_BCS_INPUT_DIR @@ -24,7 +24,6 @@ program Runoff character*5 :: C_NX, C_NY - logical :: adjust_oceanLandSea_mask = .true. ! default is .true. integer :: nxt, command_argument_count character*(128) :: arg, & Usage = "mk_runofftbl.x CF0012x6C_TM0072xTM0036-Pfafstetter", & @@ -37,7 +36,7 @@ program Runoff ! Read inputs ----------------------------------------------------- I = command_argument_count() - if (I < 1 .or. I > 3) then + if (I /= 1) then print *, " " print *, "Wrong number of input arguments, got: ", I print *, "Example usage with defaults: " @@ -52,21 +51,6 @@ program Runoff print *, " " print*, "Working with input BCs string: ", file print *, " " - if (I > 1) then - nxt = nxt + 1 - call get_command_argument(nxt, arg) - !if ( trim(arg) .ne. 'yes') then - ! print *, "Incorrect optional second argument, should be: yes" - ! call exit(2) - !else - ! adjust_oceanLandSea_mask = .true. - ! nxt = nxt + 1 - ! call get_command_argument(nxt, mapl_tp_file) - !endif - if ( trim(arg) .eq. 'no') then - adjust_oceanLandSea_mask = .false. - endif - endif ! ------------------------------------------------------------------ fileT = "til/"//trim(file)//".til" ! input @@ -104,49 +88,13 @@ program Runoff end do close(30) -! do j=1,ny -!! if (mod(j,100) == 0) print *,'J=',j -! do i=1,nx -! ii = Lons(i,j) -! jj = lats(i,j) -! -! if(ii==-999 .or. jj==-999) then -! ! ii = i -! ! jj = j -! cycle -! endif -! -! if(ii==i .and. jj==j) then -! print *, '>>> Inland Ocean Point ', ii, jj, lons(i,j), lats(i,j) -! stop -! end if -! -! end do -! end do -! stop "DONE" -! Count the number of Ocean and land tiles in the tile file -! All land tiles preceed the ocean tiles. -!---------------------------------------------------------- - -! If asked for, adjust tiles to be -! comptabile with ocean model land-sea mask and write ANOTHER output file -!------------------------------------------------------------------------- - - if (adjust_oceanLandSea_mask) then - fileBB = "til/"//trim(file)//"_oceanMask_adj.TRN" ! output - - print *, " " - print *, "Accounting for any mismatch between land-sea masks:" - print *, "- Of GEOS land and external ocean model." - print *, "- Output file: ", fileB - print *, " " -! call read_oceanModel_mask( mapl_tp_file) - call outlets_to_ocean(file,lons,lats,nx,ny) -! ... some adjustment of following variable: `type` -! ... using ocean model land-sea mask should be done here - endif + print *, " " + print *, "Accounting for any mismatch between land-sea masks:" + print *, "- Of GEOS land and external ocean model." + print *, "- Output file: ", fileB + print *, " " + call outlets_to_ocean(file,lons,lats,nx,ny) -! print *, "Reading til file "//trim(fileT) open(10,file=fileT, form="formatted", status="old") @@ -325,8 +273,8 @@ program Runoff close(10) call write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) - if (adjust_oceanLandSea_mask) & - call write_route_file( fileBB, NumTrans, SrcTile, DstTile, SrcFraction) +! if (adjust_oceanLandSea_mask) & +! call write_route_file( fileBB, NumTrans, SrcTile, DstTile, SrcFraction) do j=1,NumTrans Out(DstTile(j)) = Out(DstTile(j)) + In(SrcTile(J))*SrcFraction(J) @@ -347,33 +295,6 @@ program Runoff ! ----------------------------------------------------------------- contains - subroutine read_oceanModel_mask( mask_file) - implicit none - character*128, intent(in) :: mask_file - integer :: nx, ny - real, allocatable :: wetMask(:,:) - - integer :: ncid, varid - - print *, "Reading ocean model mask from : ", mask_file - call check( nf90_open(mask_file, nf90_nowrite, ncid)) ! open nc file - - call check( nf90_inq_dimid(ncid, "n_center_x", varid)) ! read dimenstion (x) - call check( nf90_inquire_dimension(ncid, varid, len=nx)) - - call check( nf90_inq_dimid(ncid, "n_center_y", varid)) ! read dimenstion (y) - call check( nf90_inquire_dimension(ncid, varid, len=ny)) - - allocate( wetMask(nx, ny)) - call check( nf90_inq_varid(ncid, "mask", varid)) ! read mask - call check( nf90_get_var(ncid, varid, wetMask)) - - call check( nf90_close(ncid)) ! close nc file - - deallocate( wetMask) - end subroutine read_oceanModel_mask -! ---------------------- - subroutine write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) implicit none character*100, intent(in) :: fileB @@ -388,17 +309,6 @@ subroutine write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) write(10) SrcFraction close(10) end subroutine write_route_file -! ---------------------- - - subroutine check(status) - implicit none - integer, intent (in) :: status - if (status /= nf90_noerr) then - print *, trim(nf90_strerror(status)) - print *, "Error in reading ocean mask file." - stop - end if - end subroutine check !------------------------------------------------------------------------ subroutine outlets_to_ocean(file,lons,lats,nx,ny) @@ -531,10 +441,6 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) !print *,"outlets num is ",ns allocate(loni_lnd(ns),lati_lnd(ns)) - allocate(msk1d(nt_ocn)) - allocate(msk2d(nx,ny)) - allocate(mask(nx,ny)) - allocate(boundary(nx,ny)) allocate(lons_adj(ns),lats_adj(ns)) allocate(loni_ocn(ns),lati_ocn(ns)) allocate(ns_map(nx,ny)) @@ -542,12 +448,18 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) !print *,"running retrieve_outlets() ..." call retrieve_outlets(lons,lats,lon30s,lat30s,loni_lnd,lati_lnd,lon_lnd,lat_lnd,ns_map,nx,ny,ns) !print *,"running mask_MAPL_1d() ..." + allocate(msk1d(nt_ocn)) call mask_MAPL_1d(msk1d,t2loni,t2lati,nt_ocn,res_MAPL,nx_MAPL,ny_MAPL) !print *,"running mask_MAPL_2d() ..." + allocate(msk2d(nx,ny)) call mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt_ocn,nx,ny) + deallocate(rst_ocn,msk1d) !print *,"running mask_MAPL_bcs() ..." + allocate(mask(nx,ny)) call mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nx,ny,nl_ocn_lnd,nt_ocn_lnd) + deallocate(msk2d,rst_ocn_lnd) !print *,"running ocean_boundary() ..." + allocate(boundary(nx,ny)) call ocean_boundary(mask,boundary,nx,ny) !print *,"running ocean_boundary_num() ..." call ocean_boundary_num(boundary,nx,ny,nsh) @@ -555,18 +467,18 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) allocate(lonsh(nsh),latsh(nsh)) !print *,"running ocean_boundary_points() ..." call ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nx,ny,nsh) + deallocate(boundary) !print *,"running move_to_ocean() ..." - call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) + call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) + deallocate(mask,lonsh,latsh) !print *,"running sinkxy_ocean() ..." call sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni_ocn,lati_ocn,ns,nx,ny) !print *,"running update_outlets() ..." call update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) - deallocate(loni_lnd,lati_lnd,msk1d,msk2d,mask,& - boundary,lonsh,latsh,lons_adj,lats_adj,loni_ocn,lati_ocn) - deallocate(rst_ocn,lat30s,lon30s) + deallocate(loni_lnd,lati_lnd,lons_adj,lats_adj,loni_ocn,lati_ocn) + deallocate(lon30s,lat30s) deallocate(ns_map,lon_lnd,lat_lnd) - deallocate(rst_ocn_lnd) end subroutine outlets_to_ocean !------------------------------------------------------------------------- @@ -748,8 +660,6 @@ subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) integer :: i,j,xi,yi,tid !print *,"running mask_MAPL_2d() ..." - - do i=1,nlon do j=1,nlat tid=landocean(i,j) @@ -757,27 +667,18 @@ subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) enddo enddo - end subroutine mask_MAPL_2d !------------------------------------------------------------------------ -subroutine mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nlon,nlat,nl,nt) +subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) integer,intent(in) :: nlon,nlat,nl,nt integer,intent(in) :: rst_ocn_lnd(nlon,nlat) -integer,intent(in) :: msk2d(nlon,nlat) +integer,intent(in) :: mask_mapl(nlon,nlat) integer,intent(out) :: mask(nlon,nlat) -real*8,allocatable :: lon(:),lat(:) - -integer,allocatable,dimension(:,:) :: mask_mapl,mask_rst - !print *,"running mask_MAPL_bcs() ..." - -allocate(mask_mapl(nlon,nlat),lon(nlon),lat(nlat)) -mask_mapl=msk2d mask=0 where(rst_ocn_lnd>nl.and.rst_ocn_lnd/=nt.and.rst_ocn_lnd/=nt-1.and.mask_mapl==1)mask=1 -deallocate(mask_mapl,lon,lat) end subroutine mask_MAPL_bcs !------------------------------------------------------------------------ @@ -789,40 +690,34 @@ subroutine ocean_boundary(mask,boundary,nlon,nlat) real*8,allocatable :: lon(:),lat(:) -integer,allocatable :: catchind(:,:) integer :: xi,yi,id integer :: xp1,xm1,yp1,ym1 !print *,"running ocean_boundary() ..." -allocate(catchind(nlon,nlat),lon(nlon),lat(nlat)) -catchind=mask - -boundary=catchind +boundary=mask boundary=-9999 do xi=2,nlon-1 do yi=2,nlat-1 - id=catchind(xi,yi) + id=mask(xi,yi) if(id==1)then boundary(xi,yi)=0 - if(catchind(xi+1,yi)==1.and.& - catchind(xi+1,yi-1)==1.and.& - catchind(xi ,yi-1)==1.and.& - catchind(xi-1,yi-1)==1.and.& - catchind(xi-1,yi)==1.and.& - catchind(xi-1,yi+1)==1.and.& - catchind(xi ,yi+1)==1.and.& - catchind(xi+1,yi+1)==1)then + if(mask(xi+1,yi)==1.and.& + mask(xi+1,yi-1)==1.and.& + mask(xi ,yi-1)==1.and.& + mask(xi-1,yi-1)==1.and.& + mask(xi-1,yi)==1.and.& + mask(xi-1,yi+1)==1.and.& + mask(xi ,yi+1)==1.and.& + mask(xi+1,yi+1)==1)then boundary(xi,yi)=-9999 endif endif enddo enddo -deallocate(catchind,lon,lat) - end subroutine ocean_boundary !------------------------------------------------------------------------ subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) @@ -866,17 +761,16 @@ subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) enddo end subroutine ocean_boundary_points !------------------------------------------------------------------------ -subroutine move_to_ocean(loni_lnd,lati_lnd,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) +subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) integer,intent(in) :: ns,nlon,nlat,nsh -integer,intent(in) :: loni_lnd(ns),lati_lnd(ns) +integer,intent(in) :: lonsi(ns),latsi(ns) real*8,intent(in) :: lons(ns),lats(ns) integer,intent(in) :: mask(nlon,nlat) real*8,intent(in) :: lonsh(nsh),latsh(nsh) real*8,intent(out) :: lons_adj(ns),lats_adj(ns) -integer,allocatable :: lonsi(:),latsi(:) -integer,allocatable :: catid(:),flag(:) +!integer,allocatable :: catid(:),flag(:) real,allocatable :: dist(:) @@ -885,10 +779,7 @@ subroutine move_to_ocean(loni_lnd,lati_lnd,lons,lats,mask,lonsh,latsh,lons_adj,l !print *,"running move_to_ocean() ..." -allocate(lonsi(ns),latsi(ns)) -allocate(catid(ns),flag(ns),dist(ns)) -lonsi=loni_lnd -latsi=lati_lnd +allocate(dist(ns)) do i=1,ns IF(mask(lonsi(i),latsi(i))==0)THEN dist(i)=1.e12 @@ -912,27 +803,24 @@ subroutine move_to_ocean(loni_lnd,lati_lnd,lons,lats,mask,lonsh,latsh,lons_adj,l dist(i)=0. ENDIF enddo -deallocate(lonsi,latsi,catid,flag,dist) +deallocate(dist) end subroutine move_to_ocean !------------------------------------------------------------------------ -subroutine sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni,lati,ns,nlon,nlat) +subroutine sinkxy_ocean(lons,lats,lon30s,lat30s,loni,lati,ns,nlon,nlat) integer,intent(in) :: ns,nlon,nlat -real*8,intent(in) :: lons_adj(ns),lats_adj(ns) +real*8,intent(in) :: lons(ns),lats(ns) real*8,intent(in) :: lon30s(nlon),lat30s(nlat) integer,intent(out) :: loni(ns),lati(ns) -real*8,allocatable,dimension(:) :: lats,lons,lat_dis,lon_dis +real*8,allocatable,dimension(:) :: lat_dis,lon_dis integer :: i,temp(1) !print *,"running sinkxy_ocean() ..." -allocate(lats(ns),lons(ns)) allocate(lat_dis(nlat),lon_dis(nlon)) -lats=lats_adj -lons=lons_adj do i=1,ns lat_dis=abs(lat30s-lats(i)) @@ -945,7 +833,7 @@ subroutine sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni,lati,ns,nlon,nlat) loni(i)=temp(1) enddo -deallocate(lats,lons,lat_dis,lon_dis) +deallocate(lat_dis,lon_dis) end subroutine sinkxy_ocean !------------------------------------------------------------------------ From 859e63b49f520de68fb6f283fd46c6f9e3a7a0b6 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 3 Nov 2023 12:47:56 -0400 Subject: [PATCH 09/55] change the mk_runofftbl.F90 to make the ocean resolution not hard coded. --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 70 ++++++++++++++----- 1 file changed, 52 insertions(+), 18 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 3f608b0a8..f2aef6f7d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -329,17 +329,18 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) character*100 :: file_ocn_lnd character*100 :: fileT_ocn_lnd, fileR_ocn_lnd character*100 :: res_MAPL + character*100 :: nx_str,ny_str integer, allocatable,dimension(:,:) :: rst_ocn,rst_ocn_lnd real :: num1,num2,num3,num4 integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh integer, allocatable,dimension(:) :: t2lati,t2loni real*8,allocatable,dimension(:) :: lon30s,lat30s real*8 :: dx,dy - integer :: ns + integer :: ns,nstr1,nstr2 integer,allocatable,dimension(:,:) :: ns_map real*8,allocatable,dimension(:) :: lat_lnd,lon_lnd - integer :: i,j,l,k,status,type,np + integer :: i,j,l,k,status,type,np,flag,flag2 do i=1,100 if(file(i:i).eq."T".and.file(i+1:i+1).eq."M")then @@ -354,22 +355,55 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) file_ocn_lnd(14:25)="-Pfafstetter" !print *,trim(file_ocn_lnd) - if(trim(file_ocn).eq."TM0072xTM0036")then - res_MAPL="72x36" - nx_MAPL=72 - ny_MAPL=36 - else if(trim(file_ocn).eq."TM0540xTM0458")then - res_MAPL="540x458" - nx_MAPL=540 - ny_MAPL=458 - else if(trim(file_ocn).eq."TM1440xTM1080")then - res_MAPL="1440x1080" - nx_MAPL=1440 - ny_MAPL=1080 - else - print *,"ocean resolution is not supported!" - stop - endif + nx_str="" + ny_str="" + res_MAPL="" + flag=0 + k=1 + do i=1,100 + if(flag==0)then + if(file_ocn(i:i).ne."T".and.file_ocn(i:i).ne."M".and.file_ocn(i:i).ne."0")then + flag=1 + nx_str(k:k)=file_ocn(i:i) + k=k+1 + endif + else if(flag==1)then + if(file_ocn(i:i).eq."x")exit + nx_str(k:k)=file_ocn(i:i) + k=k+1 + endif + enddo +! print *,trim(nx_str) + nstr1=k-1 +! print *,nstr1 + + flag=0 + flag2=0 + k=1 + do i=1,100 + IF(flag2==1)THEN + if(flag==0)then + if(file_ocn(i:i).ne."T".and.file_ocn(i:i).ne."M".and.file_ocn(i:i).ne."0")then + flag=1 + ny_str(k:k)=file_ocn(i:i) + k=k+1 + endif + else if(flag==1)then + if(file_ocn(i:i).eq." ")exit + ny_str(k:k)=file_ocn(i:i) + k=k+1 + endif + ELSE + if(file_ocn(i:i).eq."x")flag2=1 + ENDIF + enddo +! print *,trim(ny_str) + nstr2=k-1 +! print *,nstr2 + res_MAPL(1:nstr1+nstr2+1)=trim(nx_str)//"x"//trim(ny_str) + !print *,trim(res_MAPL) + read(nx_str,*)nx_MAPL + read(ny_str,*)ny_MAPL fileT_ocn = "til/"//trim(file_ocn)//".til" ! input fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input From ae80fdf27c95539bea81380841ce7cb4904f9aac Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 3 Nov 2023 21:34:20 -0400 Subject: [PATCH 10/55] preprocess cleaned up, only the outlet locations in land are produced --- ..._to_2d_30s.f90 => Pfaf_to_2d_30s_land.f90} | 6 +- ...6.f90 => get_landocean_Greenland_real.f90} | 16 ++-- .../preproc/routing/get_mask_MAPL_1d.f90 | 32 ------- .../preproc/routing/get_mask_MAPL_2d.f90 | 36 -------- .../routing/get_mask_TM0072xTM0036.f90 | 29 ------- .../get_oceanbond_TM0072xTM0036_mask.f90 | 53 ------------ ...et_oceanbond_points_TM0072xTM0036_mask.f90 | 55 ------------ ...allcat.f90 => get_outlets_land_allcat.f90} | 8 +- .../preproc/routing/get_sinkxy_ocean.f90 | 46 ---------- .../preproc/routing/mv_outlets_ocean.f90 | 83 ------------------- ...eroutlet.f90 => read_riveroutlet_land.f90} | 4 +- .../Utils/Raster/preproc/routing/run.sh | 70 +++++----------- 12 files changed, 36 insertions(+), 402 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{Pfaf_to_2d_30s.f90 => Pfaf_to_2d_30s_land.f90} (86%) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{get_landocean_Greenland_real_TM0072xTM0036.f90 => get_landocean_Greenland_real.f90} (74%) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{get_outlets_ocean_allcat.f90 => get_outlets_land_allcat.f90} (81%) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{read_riveroutlet.f90 => read_riveroutlet_land.f90} (75%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 similarity index 86% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 index 155022964..7a54168e3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 @@ -4,9 +4,9 @@ program main use rwncfile implicit none -character(len=100) :: var1="outlet_sinky_allcat_TM0072xTM0036_mask" -character(len=100) :: var2="outlet_sinkx_allcat_TM0072xTM0036_mask" -character(len=100) :: map="TM0072xTM0036-Pfafstetter_Greenland_real.nc" +character(len=100) :: var1="outlet_sinky_allcat" +character(len=100) :: var2="outlet_sinkx_allcat" +character(len=100) :: map="Pfafstetter_Greenland_real.nc" integer,parameter :: nc=291809 integer,parameter :: nlon=43200 integer,parameter :: nlat=21600 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 similarity index 74% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 5773029c5..84666afe2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real_TM0072xTM0036.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -14,9 +14,9 @@ program main integer,parameter :: lati_min=16801 integer,parameter :: lati_max=21600 -integer,parameter :: id_glac=286926 -integer,parameter :: id_lake=286925 -integer,parameter :: id_landend=284954 +integer,parameter :: id_glac=290191 +integer,parameter :: id_lake=290190 +integer,parameter :: id_landend=290188 real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G integer,allocatable,dimension(:,:) :: landocean,Greenland @@ -26,9 +26,9 @@ program main allocate(landocean(nlon,nlat)) allocate(lon(nlon),lat(nlat)) -call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter.nc","lon",lon,nlon) -call read_ncfile_double1d("inputs/TM0072xTM0036-Pfafstetter.nc","lat",lat,nlat) -call read_ncfile_int2d("inputs/TM0072xTM0036-Pfafstetter.nc","data",landocean,nlon,nlat) +call read_ncfile_double1d("inputs/Pfafstetter.nc","lon",lon,nlon) +call read_ncfile_double1d("inputs/Pfafstetter.nc","lat",lat,nlat) +call read_ncfile_int2d("inputs/Pfafstetter.nc","data",landocean,nlon,nlat) allocate(Greenland(nlon_G,nlat_G)) allocate(lon_G(nlon_G),lat_G(nlat_G)) @@ -45,7 +45,7 @@ program main where(landocean==id_lake.or.landocean==id_glac) landocean=0 allocate(Pfaf_real(id_landend)) -open(77,file="inputs/TM0072xTM0036-Pfaf_real.txt") +open(77,file="inputs/Pfaf_real.txt") read(77,*)Pfaf_real do i=1,nlon @@ -60,7 +60,7 @@ program main -call create_ncfile_int2d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","data",landocean,lon,lat,nlon,nlat) +call create_ncfile_int2d("outputs/Pfafstetter_Greenland_real.nc","data",landocean,lon,lat,nlon,nlat) end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 deleted file mode 100755 index eb9cf232d..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_1d.f90 +++ /dev/null @@ -1,32 +0,0 @@ -program main - -use rwncfile -implicit none - -integer,parameter :: nt=2592 -integer,parameter :: nlon=72 -integer,parameter :: nlat=36 - -real,allocatable,dimension(:,:) :: msk_MAPL -integer,allocatable,dimension(:) :: t2lati,t2loni,msk_tile - -integer :: i - -allocate(msk_MAPL(nlon,nlat)) -allocate(t2lati(nt),t2loni(nt),msk_tile(nt)) -call read_ncfile_real2d("inputs/MAPL_Tripolar.nc","mask",msk_MAPL,nlon,nlat) -open(77,file="inputs/TM0072xTM0036_tile_to_MAPL_lati.txt") -read(77,*)t2lati -open(77,file="inputs/TM0072xTM0036_tile_to_MAPL_loni.txt") -read(77,*)t2loni - -do i=1,nt - msk_tile(i)=int(msk_MAPL(t2loni(i),t2lati(i))) -enddo - -open(88,file="outputs/mask_MAPL_1d_TM0072xTM0036.txt") -do i=1,nt - write(88,*)msk_tile(i) -enddo - -end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 deleted file mode 100755 index acf3aec00..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_MAPL_2d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -program main - -use omp_lib -use rwncfile -implicit none - -integer,parameter :: nlon=43200 -integer,parameter :: nlat=21600 -integer,parameter :: nt=2592 - -real*8,allocatable,dimension(:) :: lon,lat -integer,allocatable,dimension(:,:) :: landocean,mask -integer,allocatable,dimension(:) :: mask1d - -integer :: i,j,xi,yi,tid - -allocate(landocean(nlon,nlat)) -allocate(lon(nlon),lat(nlat)) -call read_ncfile_double1d("inputs/TM0072xTM0036.nc","lon",lon,nlon) -call read_ncfile_double1d("inputs/TM0072xTM0036.nc","lat",lat,nlat) -call read_ncfile_int2d("inputs/TM0072xTM0036.nc","data",landocean,nlon,nlat) - - -allocate(mask(nlon,nlat),mask1d(nt)) -open(77,file="outputs/mask_MAPL_1d_TM0072xTM0036.txt") -read(77,*)mask1d -do i=1,nlon - do j=1,nlat - tid=landocean(i,j) - mask(i,j)=mask1d(tid) - enddo -enddo -call create_ncfile_int2d("outputs/mask_MAPL_TM0072xTM0036.nc","data",mask,lon,lat,nlon,nlat) - - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 deleted file mode 100755 index d9c8923a7..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_mask_TM0072xTM0036.f90 +++ /dev/null @@ -1,29 +0,0 @@ -program main - -use omp_lib -use rwncfile - -implicit none - -integer,parameter :: nlon=43200 -integer,parameter :: nlat=21600 -real*8,allocatable :: lon(:),lat(:) - -integer,allocatable,dimension(:,:) :: mask_mapl,mask_rst,mask - -allocate(mask_mapl(nlon,nlat),mask_rst(nlon,nlat),lon(nlon),lat(nlat),mask(nlon,nlat)) - -call read_ncfile_double1d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lon",lon,nlon) -call read_ncfile_double1d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","lat",lat,nlat) -call read_ncfile_int2d("outputs/TM0072xTM0036-Pfafstetter_Greenland_real.nc","data",mask_rst,nlon,nlat) -call read_ncfile_int2d("outputs/mask_MAPL_TM0072xTM0036.nc","data",mask_mapl,nlon,nlat) - - -mask=0 -where(mask_rst==-9999..and.mask_mapl==1)mask=1 - -call create_ncfile_int2d("outputs/TM0072xTM0036_mask.nc","data",mask,lon,lat,nlon,nlat) - - - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 deleted file mode 100755 index 5e9091229..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_TM0072xTM0036_mask.f90 +++ /dev/null @@ -1,53 +0,0 @@ -program main - -use omp_lib -use rwncfile -implicit none - -integer,parameter :: nlon=43200 -integer,parameter :: nlat=21600 -real*8,allocatable :: lon(:),lat(:) - -integer,allocatable :: catchind(:,:) -integer,allocatable :: boundary(:,:) - -integer :: xi,yi,id -integer :: xp1,xm1,yp1,ym1 - -allocate(catchind(nlon,nlat),boundary(nlon,nlat),lon(nlon),lat(nlat)) -call read_ncfile_double1d("outputs/TM0072xTM0036_mask.nc","lon",lon,nlon) -call read_ncfile_double1d("outputs/TM0072xTM0036_mask.nc","lat",lat,nlat) -call read_ncfile_int2d("outputs/TM0072xTM0036_mask.nc","data",catchind,nlon,nlat) - -boundary=catchind -boundary=-9999 - -!$OMP PARALLEL default(shared) private(xi,yi,id) -!$OMP DO -do xi=2,nlon-1 - !if(mod(xi,100)==0)then - ! print *,xi - !endif - do yi=2,nlat-1 - id=catchind(xi,yi) - if(id==1)then - boundary(xi,yi)=0 - if(catchind(xi+1,yi)==1.and.& - catchind(xi+1,yi-1)==1.and.& - catchind(xi ,yi-1)==1.and.& - catchind(xi-1,yi-1)==1.and.& - catchind(xi-1,yi)==1.and.& - catchind(xi-1,yi+1)==1.and.& - catchind(xi ,yi+1)==1.and.& - catchind(xi+1,yi+1)==1)then - boundary(xi,yi)=-9999 - endif - endif - enddo -enddo -!$OMP END DO -!$OMP END PARALLEL - -call create_ncfile_int2d("outputs/TM0072xTM0036_mask_oceanboundary.nc","data",boundary,lon,lat,nlon,nlat) - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 deleted file mode 100755 index 0bc8a3a4d..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_oceanbond_points_TM0072xTM0036_mask.f90 +++ /dev/null @@ -1,55 +0,0 @@ -program main - -use omp_lib -use rwncfile -implicit none - -integer,parameter :: nsh=788292 !304483 !1877262 -integer,parameter :: nlonh=43200 -integer,parameter :: nlath=21600 -real*8,allocatable :: lonh(:),lath(:) -integer,allocatable :: mskh(:,:) -real*8,allocatable :: lonsh(:),latsh(:) - -integer i,xi,yi,k - - -allocate(mskh(nlonh,nlath)) -allocate(lonh(nlonh),lath(nlath)) -call read_ncfile_double1d("outputs/TM0072xTM0036_mask_oceanboundary.nc","lon",lonh,nlonh) -call read_ncfile_double1d("outputs/TM0072xTM0036_mask_oceanboundary.nc","lat",lath,nlath) -call read_ncfile_int2d("outputs/TM0072xTM0036_mask_oceanboundary.nc","data",mskh,nlonh,nlath) - -allocate(lonsh(nsh),latsh(nsh)) - -k=0 -!!$OMP PARALLEL default(shared) shared(k) private(xi,yi) -!!$OMP DO -do xi=1,nlonh - do yi=1,nlath - if(mskh(xi,yi)==0)then - k=k+1 - lonsh(k)=lonh(xi) - latsh(k)=lath(yi) - endif - enddo -enddo -!!$OMP END DO -!!$OMP END PARALLEL -!print *,k - - -open(88,file="outputs/lon_oceanbond_list_TM0072xTM0036_mask.txt") -do i=1,nsh - write(88,*)lonsh(i) -enddo -open(88,file="outputs/lat_oceanbond_list_TM0072xTM0036_mask.txt") -do i=1,nsh - write(88,*)latsh(i) -enddo - - - - - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 similarity index 81% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 index 7c72e6333..61b81bb9d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_ocean_allcat.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 @@ -20,9 +20,9 @@ program main read(77,*)id_final open(77,file="outputs/outlet_catchindex.txt") read(77,*)id_outlet -open(77,file="outputs/outlet_sinky_TM0072xTM0036_mask.txt") +open(77,file="outputs/outlet_sinky.txt") read(77,*)lati_outlet -open(77,file="outputs/outlet_sinkx_TM0072xTM0036_mask.txt") +open(77,file="outputs/outlet_sinkx.txt") read(77,*)loni_outlet open(77,file="outputs/Pfaf_msk_all.txt") read(77,*)msk @@ -45,11 +45,11 @@ program main endif end do -open(88,file="outputs/outlet_sinky_allcat_TM0072xTM0036_mask.txt") +open(88,file="outputs/outlet_sinky_allcat.txt") do i=1,nall write(88,*)lati_full(i) enddo -open(88,file="outputs/outlet_sinkx_allcat_TM0072xTM0036_mask.txt") +open(88,file="outputs/outlet_sinkx_allcat.txt") do i=1,nall write(88,*)loni_full(i) enddo diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 deleted file mode 100755 index 2412a0af0..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_ocean.f90 +++ /dev/null @@ -1,46 +0,0 @@ -program main - -use rwncfile -implicit none - -integer,parameter :: ns=22612 -integer,parameter :: nlat=21600 -integer,parameter :: nlon=43200 - -real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis -integer,allocatable,dimension(:) :: lati,loni - -integer :: i,temp(1) - -allocate(lats(ns),lons(ns),lati(ns),loni(ns)) -allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) -open(77,file="outputs/outlet_sinklat_TM0072xTM0036_mask.txt") -read(77,*)lats -open(77,file="outputs/outlet_sinklon_TM0072xTM0036_mask.txt") -read(77,*)lons -open(77,file="inputs/lat_30s.txt") -read(77,*)lat30s -open(77,file="inputs/lon_30s.txt") -read(77,*)lon30s - -do i=1,ns - lat_dis=abs(lat30s-lats(i)) - temp=minloc(lat_dis) - lati(i)=temp(1) -enddo -do i=1,ns - lon_dis=abs(lon30s-lons(i)) - temp=minloc(lon_dis) - loni(i)=temp(1) -enddo - -open(88,file="outputs/outlet_sinky_TM0072xTM0036_mask.txt") -do i=1,ns - write(88,*)lati(i) -enddo -open(88,file="outputs/outlet_sinkx_TM0072xTM0036_mask.txt") -do i=1,ns - write(88,*)loni(i) -enddo - -end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 deleted file mode 100755 index 5533e7d00..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/mv_outlets_ocean.f90 +++ /dev/null @@ -1,83 +0,0 @@ -program main - -use omp_lib -use rwncfile -implicit none - -integer,parameter :: nsh=788292 -integer,parameter :: ns=22612 -integer,parameter :: nlon=43200 -integer,parameter :: nlat=21600 - -integer,allocatable :: mask(:,:) - -real*8 :: lons(ns),lats(ns) -integer :: lonsi(ns),latsi(ns) -real*8 :: lons_adj(ns),lats_adj(ns) -real*8,allocatable :: lonsh(:),latsh(:) -integer :: catid(ns),flag(ns) - -real :: dist(ns) - -integer :: i,j -real :: dy,dy2,dx,dx2,dxA,dxB,dist_temp - -allocate(lonsh(nsh),latsh(nsh)) - -open(77,file="outputs/outlet_sinklon.txt") -read(77,*)lons -open(77,file="outputs/outlet_sinklat.txt") -read(77,*)lats -open(77,file="outputs/outlet_sinkx.txt") -read(77,*)lonsi -open(77,file="outputs/outlet_sinky.txt") -read(77,*)latsi - -open(77,file="outputs/lon_oceanbond_list_TM0072xTM0036_mask.txt") -read(77,*)lonsh -open(77,file="outputs/lat_oceanbond_list_TM0072xTM0036_mask.txt") -read(77,*)latsh - -allocate(mask(nlon,nlat)) -call read_ncfile_int2d("outputs/TM0072xTM0036_mask.nc","data",mask,nlon,nlat) - -!$OMP PARALLEL default(shared) private(i,j,dy,dy2,dx,dx2,dxA,dxB,dist_temp) -!$OMP DO -do i=1,ns - !if(mod(i,100)==0) print *,i - IF(mask(lonsi(i),latsi(i))==0)THEN - dist(i)=1.e12 - do j=1,nsh - dy=abs(lats(i)-latsh(j)) - dy2=dy*dy - dxA=abs(lons(i)-lonsh(j)) - dxB=360.-dxA - dx=min(dxA,dxB) - dx2=dx*dx - dist_temp=sqrt(dx2+dy2) - if(dist_temp Date: Wed, 8 Nov 2023 15:34:18 -0500 Subject: [PATCH 11/55] readme.txt added --- .../Utils/Raster/preproc/routing/readme.txt | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt new file mode 100644 index 000000000..1127cf25f --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -0,0 +1,14 @@ +v1 11/08/2023 +The package is used for creating a file for river outlet locations to ocean used in the GEOS coupled simulation. The outlet locations got from this pre-processing are in the land or glacier area defined by the mk_bcs file Pfafstetter.rst. The output is a binary file Outlet_latlon.43200x21600. This file is the input of the mk_runofftbl.F90 in the mk_bcs package. The inland outlet locations will be further moved to ocean domain by the mk_runofftbl.F90. + +If on the Discover, one can simply run the script run.sh to create the output file Outlet_latlon.43200x21600. If not on the Discover, please contact yujin.zeng@nasa.gov . + +The function for each f90 code are briefly described as follows: +1. get_outlets_catchindex.f90: get sink catchment IDs. +2. get_outlets_land.f90: get the sink points in land and Greenland (from Lauren Andrews) by picking the point (i.e., 15-sec cell) with the largest drainage area from dataset of HydroSHEDS (https://www.hydrosheds.org/) within each sink catchment. +3. get_sinkxy_land.f90: outlets degree to indexes in the 30 arc-sec map. +4. get_outlets_land_allcat.f90: Assign the outlet locations to all upstream catchments to create a 1d list showing the final x and y indexes for each catchment. +5. get_landocean_Greenland_real.f90: Insert the Greenland index map to the catchment index map. +6. Pfaf_to_2d_30s_land.f90: Transform the 1d list above to a 30s 2d map using the index map. +7. read_riveroutlet_land.f90: Transform above the 2d maps to an unformatted file Outlet_latlon.43200x21600 that can be read directly by the mk_runofftbl.F90 of mk_bcs. + From 05fbd70689cd24dad271d1467969d5a91b3d950c Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Tue, 14 Nov 2023 12:28:53 -0500 Subject: [PATCH 12/55] Updated readme.txt --- .../Utils/Raster/preproc/routing/readme.txt | 41 ++++++++++++++----- 1 file changed, 31 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt index 1127cf25f..7cb959ad1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -1,14 +1,35 @@ -v1 11/08/2023 -The package is used for creating a file for river outlet locations to ocean used in the GEOS coupled simulation. The outlet locations got from this pre-processing are in the land or glacier area defined by the mk_bcs file Pfafstetter.rst. The output is a binary file Outlet_latlon.43200x21600. This file is the input of the mk_runofftbl.F90 in the mk_bcs package. The inland outlet locations will be further moved to ocean domain by the mk_runofftbl.F90. +v1 11/08/2023, Yujin Zeng -If on the Discover, one can simply run the script run.sh to create the output file Outlet_latlon.43200x21600. If not on the Discover, please contact yujin.zeng@nasa.gov . +The "preproc/routing" package is used for creating a file with the locations of river outlets to the ocean. + +The output from this package is a binary file "Outlet_latlon.43200x21600". + +The river outlets are located in land or landice tiles as defined in the raster file "Pfafstetter.rst" from the makebcs package. + +The "Outlet_latlon.43200x21600" file is the input for "mk_runofftbl.F90" in the makebcs package, which further adjusts the outlet locations to be consistent with the ocean model resolution and domain ("mk_runofftbl.F90"). + +If on NCCS/Discover, the package can be run using the script "run.sh". If not on Discover, please contact yujin.zeng@nasa.gov. The function for each f90 code are briefly described as follows: -1. get_outlets_catchindex.f90: get sink catchment IDs. -2. get_outlets_land.f90: get the sink points in land and Greenland (from Lauren Andrews) by picking the point (i.e., 15-sec cell) with the largest drainage area from dataset of HydroSHEDS (https://www.hydrosheds.org/) within each sink catchment. -3. get_sinkxy_land.f90: outlets degree to indexes in the 30 arc-sec map. -4. get_outlets_land_allcat.f90: Assign the outlet locations to all upstream catchments to create a 1d list showing the final x and y indexes for each catchment. -5. get_landocean_Greenland_real.f90: Insert the Greenland index map to the catchment index map. -6. Pfaf_to_2d_30s_land.f90: Transform the 1d list above to a 30s 2d map using the index map. -7. read_riveroutlet_land.f90: Transform above the 2d maps to an unformatted file Outlet_latlon.43200x21600 that can be read directly by the mk_runofftbl.F90 of mk_bcs. + +1. get_outlets_catchindex.f90: +Get sink catchment IDs. + +2. get_outlets_land.f90: +Get sink points on land or in Greenland (from Lauren Andrews) by picking the point (i.e., 15-arcsec grid cell) within each sink catchment that has the largest drainage area per the HydroSHEDS (https://www.hydrosheds.org/) dataset. + +3. get_sinkxy_land.f90: +Convert outlet locations in degree lat/lon to indices on the 30 arc-sec raster grid. + +4. get_outlets_land_allcat.f90: +Assign outlet locations to all upstream catchments to create a 1d list showing the final x and y indexes for each catchment. + +5. get_landocean_Greenland_real.f90: +Insert the Greenland index map into the catchment index map. + +6. Pfaf_to_2d_30s_land.f90: +Transform the 1d list above to a 30 arc-sec 2d map using the map of indices. + +7. read_riveroutlet_land.f90: +Transform the above 2d maps to the unformatted Fortran binary file "Outlet_latlon.43200x21600" that can be read directly by "mk_runofftbl.F90" of makebcs. From f8bfb9176fef0c123b28020c4be26db0c99714ac Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Mon, 20 Nov 2023 15:52:56 -0500 Subject: [PATCH 13/55] change run.sh to run.py; remove ncdioMod.f90 and rwncMod.f90; remove build script --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 158 +- .../preproc/routing/Pfaf_to_2d_30s_land.f90 | 49 +- .../Utils/Raster/preproc/routing/build | 19 - .../Utils/Raster/preproc/routing/constant.f90 | 26 + .../routing/get_landocean_Greenland_real.f90 | 66 +- .../routing/get_outlets_catchindex.f90 | 5 +- .../preproc/routing/get_outlets_land.f90 | 41 +- .../routing/get_outlets_land_allcat.f90 | 16 +- .../preproc/routing/get_sinkxy_land.f90 | 8 +- .../Utils/Raster/preproc/routing/ncdioMod.f90 | 2582 ----------------- .../preproc/routing/read_riveroutlet_land.f90 | 29 - .../Utils/Raster/preproc/routing/run.py | 60 + .../Utils/Raster/preproc/routing/run.sh | 56 - .../Utils/Raster/preproc/routing/rwncMod.f90 | 530 ---- 14 files changed, 254 insertions(+), 3391 deletions(-) delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/ncdioMod.f90 delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet_land.f90 create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh delete mode 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index f2aef6f7d..382768079 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -89,8 +89,7 @@ program Runoff close(30) print *, " " - print *, "Accounting for any mismatch between land-sea masks:" - print *, "- Of GEOS land and external ocean model." + print *, "Determining river outlets to ocean:" print *, "- Output file: ", fileB print *, " " call outlets_to_ocean(file,lons,lats,nx,ny) @@ -312,35 +311,34 @@ end subroutine write_route_file !------------------------------------------------------------------------ subroutine outlets_to_ocean(file,lons,lats,nx,ny) - integer, intent(in) :: nx,ny - character(len=*) :: file - integer,intent(inout) :: lons(nx,ny),lats(nx,ny) + integer, intent(in) :: nx,ny + character(len=*) :: file + integer,intent(inout) :: lons(nx,ny),lats(nx,ny) - integer,allocatable,dimension(:) :: lati_lnd,loni_lnd - integer,allocatable,dimension(:) :: msk1d + integer,allocatable,dimension(:) :: lati_lnd,loni_lnd + integer,allocatable,dimension(:) :: msk1d integer,allocatable,dimension(:,:) :: msk2d integer,allocatable,dimension(:,:) :: mask integer,allocatable,dimension(:,:) :: boundary - real*8, allocatable,dimension(:) :: lonsh,latsh - real*8,allocatable,dimension(:) :: lons_adj,lats_adj - integer,allocatable,dimension(:) :: lati_ocn,loni_ocn - character*100 :: file_ocn - character*100 :: fileT_ocn, fileR_ocn - character*100 :: file_ocn_lnd - character*100 :: fileT_ocn_lnd, fileR_ocn_lnd - character*100 :: res_MAPL - character*100 :: nx_str,ny_str - integer, allocatable,dimension(:,:) :: rst_ocn,rst_ocn_lnd - real :: num1,num2,num3,num4 - integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh + real*8, allocatable,dimension(:) :: lonsh,latsh + real*8,allocatable,dimension(:) :: lons_adj,lats_adj + integer,allocatable,dimension(:) :: lati_ocn,loni_ocn + character*100 :: file_ocn + character*100 :: fileT_ocn, fileR_ocn + character*100 :: file_ocn_lnd + character*100 :: fileT_ocn_lnd, fileR_ocn_lnd + character*100 :: res_MAPL + character*100 :: nx_str,ny_str + integer, allocatable,dimension(:,:):: rst_ocn,rst_ocn_lnd + real :: num1,num2,num3,num4 + integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh integer, allocatable,dimension(:) :: t2lati,t2loni - real*8,allocatable,dimension(:) :: lon30s,lat30s - real*8 :: dx,dy - integer :: ns,nstr1,nstr2 - integer,allocatable,dimension(:,:) :: ns_map - real*8,allocatable,dimension(:) :: lat_lnd,lon_lnd - - integer :: i,j,l,k,status,type,np,flag,flag2 + real*8,allocatable,dimension(:) :: lon30s,lat30s + real*8 :: dx,dy + integer :: ns,nstr1,nstr2 + integer,allocatable,dimension(:,:) :: ns_map + real*8,allocatable,dimension(:) :: lat_lnd,lon_lnd + integer :: i,j,l,k,status,type,np,flag,flag2 do i=1,100 if(file(i:i).eq."T".and.file(i+1:i+1).eq."M")then @@ -518,15 +516,14 @@ end subroutine outlets_to_ocean !------------------------------------------------------------------------- subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) -integer,intent(in) :: nx,ny,nl,nt -integer,intent(inout) :: lons(nx,ny),lats(nx,ny) -integer,intent(in) :: rst_ocn_lnd(nx,ny) -integer,intent(out) :: ns +integer,intent(in) :: nx,ny,nl,nt +integer,intent(inout) :: lons(nx,ny),lats(nx,ny) +integer,intent(in) :: rst_ocn_lnd(nx,ny) +integer,intent(out) :: ns -integer,allocatable,dimension(:) :: lonp,latp +integer,allocatable,dimension(:) :: lonp,latp integer,allocatable,dimension(:,:) :: acc,np_map - -integer :: i,j,k,l,lonc,latc,flag,maxbak,status,num +integer :: i,j,k,l,lonc,latc,flag,maxbak,status,num !print *,"running outlets_num() ..." @@ -563,17 +560,15 @@ end subroutine outlets_num !------------------------------------------------------------------------ subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns_map,nx,ny,ns) -integer,intent(in) :: nx,ny,ns -integer,intent(in) :: lons(nx,ny),lats(nx,ny) -real*8,intent(in) :: lon30s(nx),lat30s(ny) -integer,intent(out) :: lonp(ns),latp(ns) -real*8,intent(out) :: lon_lnd(ns),lat_lnd(ns) -integer,intent(out) :: ns_map(nx,ny) - +integer,intent(in) :: nx,ny,ns +integer,intent(in) :: lons(nx,ny),lats(nx,ny) +real*8,intent(in) :: lon30s(nx),lat30s(ny) +integer,intent(out) :: lonp(ns),latp(ns) +real*8,intent(out) :: lon_lnd(ns),lat_lnd(ns) +integer,intent(out) :: ns_map(nx,ny) integer,allocatable,dimension(:,:) :: acc - -integer :: i,j,k,l,lonc,latc +integer :: i,j,k,l,lonc,latc !print *,"running retrieve_outlets() ..." @@ -610,15 +605,13 @@ end subroutine retrieve_outlets !------------------------------------------------------------------------ subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) -integer,intent(in) :: nt,nlon,nlat -integer,intent(in) :: t2loni(nt),t2lati(nt) -character(len=*) :: res_MAPL -integer,intent(out) :: msk_tile(nt) - +integer,intent(in) :: nt,nlon,nlat +integer,intent(in) :: t2loni(nt),t2lati(nt) +character(len=*) :: res_MAPL +integer,intent(out) :: msk_tile(nt) real,allocatable,dimension(:,:) :: msk_MAPL - -integer :: i +integer :: i !print *,"running mask_MAPL_1d() ..." @@ -636,11 +629,11 @@ end subroutine mask_MAPL_1d subroutine read_oceanModel_mapl(mask_file,wetMask,nx,ny) implicit none character(len=*), intent(in) :: mask_file - integer,intent(in) :: nx, ny - real :: wetMask(nx,ny) + integer,intent(in) :: nx, ny + real :: wetMask(nx,ny) - integer :: ncid, varid - character(len=4) :: subname="read" + integer :: ncid, varid + character(len=4) :: subname="read" !print *, "Reading ocean model mask from : ", mask_file @@ -654,7 +647,7 @@ end subroutine read_oceanModel_mapl subroutine check_ret(ret, calling) implicit none integer, intent(in) :: ret - character(len=*) :: calling + character(len=*) :: calling if (ret /= NF_NOERR) then !脠莽鹿没麓貌驴陋nc脦脛录镁鲁枚麓铆拢卢脭貌脤谩脢戮鲁枚麓铆脨脜脧垄 write(6,*)'netcdf error from ',trim(calling) @@ -684,14 +677,13 @@ end subroutine endrun !------------------------------------------------------------------------ subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) -integer,intent(in) :: nt,nlon,nlat -integer,intent(in) :: landocean(nlon,nlat) -integer,intent(in) :: mask1d(nt) -integer,intent(out) :: msk2d(nlon,nlat) +integer,intent(in) :: nt,nlon,nlat +integer,intent(in) :: landocean(nlon,nlat) +integer,intent(in) :: mask1d(nt) +integer,intent(out) :: msk2d(nlon,nlat) real*8,allocatable,dimension(:) :: lon,lat - -integer :: i,j,xi,yi,tid +integer :: i,j,xi,yi,tid !print *,"running mask_MAPL_2d() ..." do i=1,nlon @@ -705,9 +697,9 @@ end subroutine mask_MAPL_2d !------------------------------------------------------------------------ subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) -integer,intent(in) :: nlon,nlat,nl,nt -integer,intent(in) :: rst_ocn_lnd(nlon,nlat) -integer,intent(in) :: mask_mapl(nlon,nlat) +integer,intent(in) :: nlon,nlat,nl,nt +integer,intent(in) :: rst_ocn_lnd(nlon,nlat) +integer,intent(in) :: mask_mapl(nlon,nlat) integer,intent(out) :: mask(nlon,nlat) !print *,"running mask_MAPL_bcs() ..." @@ -718,15 +710,13 @@ end subroutine mask_MAPL_bcs !------------------------------------------------------------------------ subroutine ocean_boundary(mask,boundary,nlon,nlat) -integer,intent(in) :: nlon,nlat -integer,intent(in) :: mask(nlon,nlat) +integer,intent(in) :: nlon,nlat +integer,intent(in) :: mask(nlon,nlat) integer,intent(out) :: boundary(nlon,nlat) -real*8,allocatable :: lon(:),lat(:) - - -integer :: xi,yi,id -integer :: xp1,xm1,yp1,ym1 +real*8,allocatable :: lon(:),lat(:) +integer :: xi,yi,id +integer :: xp1,xm1,yp1,ym1 !print *,"running ocean_boundary() ..." @@ -756,8 +746,8 @@ end subroutine ocean_boundary !------------------------------------------------------------------------ subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) -integer,intent(in) :: nlon,nlat -integer,intent(in) :: mskh(nlon,nlat) +integer,intent(in) :: nlon,nlat +integer,intent(in) :: mskh(nlon,nlat) integer,intent(out) :: nsh integer i,xi,yi,k @@ -778,7 +768,7 @@ subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) integer,intent(in) :: nlon,nlat,nsh integer,intent(in) :: mskh(nlon,nlat) -real*8,intent(in) :: lon30s(nlon),lat30s(nlat) +real*8,intent(in) :: lon30s(nlon),lat30s(nlat) real*8,intent(out) :: lonsh(nsh),latsh(nsh) integer i,xi,yi,k @@ -799,9 +789,9 @@ subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_ad integer,intent(in) :: ns,nlon,nlat,nsh integer,intent(in) :: lonsi(ns),latsi(ns) -real*8,intent(in) :: lons(ns),lats(ns) +real*8,intent(in) :: lons(ns),lats(ns) integer,intent(in) :: mask(nlon,nlat) -real*8,intent(in) :: lonsh(nsh),latsh(nsh) +real*8,intent(in) :: lonsh(nsh),latsh(nsh) real*8,intent(out) :: lons_adj(ns),lats_adj(ns) !integer,allocatable :: catid(:),flag(:) @@ -843,14 +833,12 @@ end subroutine move_to_ocean !------------------------------------------------------------------------ subroutine sinkxy_ocean(lons,lats,lon30s,lat30s,loni,lati,ns,nlon,nlat) -integer,intent(in) :: ns,nlon,nlat -real*8,intent(in) :: lons(ns),lats(ns) -real*8,intent(in) :: lon30s(nlon),lat30s(nlat) -integer,intent(out) :: loni(ns),lati(ns) - +integer,intent(in) :: ns,nlon,nlat +real*8,intent(in) :: lons(ns),lats(ns) +real*8,intent(in) :: lon30s(nlon),lat30s(nlat) +integer,intent(out) :: loni(ns),lati(ns) real*8,allocatable,dimension(:) :: lat_dis,lon_dis - -integer :: i,temp(1) +integer :: i,temp(1) !print *,"running sinkxy_ocean() ..." @@ -873,9 +861,9 @@ end subroutine sinkxy_ocean !------------------------------------------------------------------------ subroutine update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) -integer,intent(in) :: nx,ny,ns -integer,intent(in) :: loni_ocn(ns),lati_ocn(ns) -integer,intent(in) :: ns_map(nx,ny) +integer,intent(in) :: nx,ny,ns +integer,intent(in) :: loni_ocn(ns),lati_ocn(ns) +integer,intent(in) :: ns_map(nx,ny) integer,intent(inout) :: lons(nx,ny),lats(nx,ny) integer :: i,j,lonc,latc,ind diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 index 7a54168e3..4016b5e57 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 @@ -1,58 +1,59 @@ program main -use omp_lib -use rwncfile +use constant,only : nall,nlon,nlat implicit none -character(len=100) :: var1="outlet_sinky_allcat" -character(len=100) :: var2="outlet_sinkx_allcat" -character(len=100) :: map="Pfafstetter_Greenland_real.nc" -integer,parameter :: nc=291809 -integer,parameter :: nlon=43200 -integer,parameter :: nlat=21600 +character(len=100) :: var1="outlet_sinky_allcat" +character(len=100) :: var2="outlet_sinkx_allcat" +character(len=100) :: map="Pfafstetter_Greenland_real" -real*8,allocatable :: lon(:),lat(:) +real*8,allocatable :: lon(:),lat(:) integer,allocatable :: catchind(:,:) -integer,allocatable :: data2d(:,:) +integer,allocatable :: lons(:,:),lats(:,:) integer,allocatable :: data_Pfaf(:) -integer :: xi,yi,id +integer :: i,j,xi,yi,id -allocate(catchind(nlon,nlat),data2d(nlon,nlat)) +allocate(catchind(nlon,nlat),lons(nlon,nlat),lats(nlon,nlat)) allocate(lon(nlon),lat(nlat)) -call read_ncfile_double1d("outputs/"//trim(map),"lon",lon,nlon) -call read_ncfile_double1d("outputs/"//trim(map),"lat",lat,nlat) -call read_ncfile_int2d("outputs/"//trim(map),"data",catchind,nlon,nlat) -allocate(data_Pfaf(nc)) +open(30,file="outputs/"//trim(map),form="unformatted") +do j = 1,nlat + read (30) catchind(:,j) +end do + +allocate(data_Pfaf(nall)) open(77,file="outputs/"//trim(var1)//".txt") read(77,*)data_Pfaf -data2d=-999 +lats=-999 do xi=1,nlon do yi=1,nlat - if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nc)then + if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then id=catchind(xi,yi) - data2d(xi,yi)=data_Pfaf(id) + lats(xi,yi)=data_Pfaf(id) endif enddo enddo -call create_ncfile_int2d_fill("outputs/"//trim(var1)//"_2d.nc","data",data2d,lon,lat,nlon,nlat,-999.) open(77,file="outputs/"//trim(var2)//".txt") read(77,*)data_Pfaf -data2d=-999 +lons=-999 do xi=1,nlon do yi=1,nlat - if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nc)then + if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then id=catchind(xi,yi) - data2d(xi,yi)=data_Pfaf(id) + lons(xi,yi)=data_Pfaf(id) endif enddo enddo -call create_ncfile_int2d_fill("outputs/"//trim(var2)//"_2d.nc","data",data2d,lon,lat,nlon,nlat,-999.) +open(30,file="Outlet_latlon.43200x21600",form="unformatted") +do j = 1, nlat + write (30) lons(:,j) + write (30) lats(:,j) +end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build deleted file mode 100755 index 35fe7f277..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/build +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/bash - -if [ $# -lt 1 ]; then - echo "no f90 specified" - exit -fi - -string=$1 -array=(${string//./ }) - -FILENAME=${array[0]} - - -NETCDF_PATH=/discover/nobackup/yzeng3/apps/netcdf-4.2.1.1 - -ifort -qopenmp ncdioMod.f90 rwncMod.f90 ${FILENAME}.f90 -I$NETCDF_PATH/include -L$NETCDF_PATH/lib -L/usr/local/intel/oneapi/2021/compiler/2021.4.0/linux/lib -lnetcdf -lnetcdff -o ${FILENAME}.out - - - diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 new file mode 100644 index 000000000..18abd28b8 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 @@ -0,0 +1,26 @@ +module constant + +implicit none +public + +integer,parameter :: nlon=43200 !number of lat of the world grid with 30 sec resolution +integer,parameter :: nlat=21600 !number of lon of the world grid with 30 sec resolution +integer,parameter :: nlon1m=21600 !number of lat of the world grid with 1m resolution +integer,parameter :: nlat1m=10800 !number of lon of the world grid with 1m resolution +integer,parameter :: nlon_G=8400 !number of lat of the Greenland grid (30 sec resolution) +integer,parameter :: nlat_G=4800 !number of lon of the Greenland grid (30 sec resolution) +integer,parameter :: loni_min=12001 !index of the lon start of the Greenland grid in the world grid (30 sec resolution) +integer,parameter :: loni_max=20400 !index of the lon end of the Greenland in the world grid (30 sec resolution) +integer,parameter :: lati_min=16801 !index of the lat start of the Greenland grid in the world grid (30 sec resolution) +integer,parameter :: lati_max=21600 !index of the lat end of the Greenland in the world grid (30 sec resolution) +integer,parameter :: id_glac=290191 !index of glacier tiles in the Pfafstetter.rst +integer,parameter :: id_lake=290190 !index of lake tiles in the Pfafstetter.rst +integer,parameter :: id_landend=290188 !index of the last land tile in the Pfafstetter.rst +integer,parameter :: nc=291284 !number of catchments in land +integer,parameter :: ns=22612 !number of outlets to ocean +integer,parameter :: ng=525 !number of catchments in Greenland +integer,parameter :: nl=22087 !number of outlets to ocean in land (not including Greenland) +integer,parameter :: nall=291809 !total number of catchments in land and Greenland + + +end module constant \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 84666afe2..786a8cc0f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -1,40 +1,48 @@ program main -use omp_lib -use rwncfile +use constant, only : nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,id_glac,id_lake,id_landend + implicit none +include 'netcdf.inc' -integer,parameter :: nc=291809 -integer,parameter :: nlon=43200 -integer,parameter :: nlat=21600 -integer,parameter :: nlon_G=8400 -integer,parameter :: nlat_G=4800 -integer,parameter :: loni_min=12001 -integer,parameter :: loni_max=20400 -integer,parameter :: lati_min=16801 -integer,parameter :: lati_max=21600 - -integer,parameter :: id_glac=290191 -integer,parameter :: id_lake=290190 -integer,parameter :: id_landend=290188 - -real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G +real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G integer,allocatable,dimension(:,:) :: landocean,Greenland -integer,allocatable,dimension(:) :: Pfaf_real, countc +integer,allocatable,dimension(:) :: Pfaf_real, countc -integer :: i,j +integer :: i,j,ret,ncid,varid allocate(landocean(nlon,nlat)) allocate(lon(nlon),lat(nlat)) -call read_ncfile_double1d("inputs/Pfafstetter.nc","lon",lon,nlon) -call read_ncfile_double1d("inputs/Pfafstetter.nc","lat",lat,nlat) -call read_ncfile_int2d("inputs/Pfafstetter.nc","data",landocean,nlon,nlat) + +ret=nf_open("inputs/Pfafstetter.nc",0,ncid) +ret=nf_inq_varid(ncid,"lon",varid) +ret=nf_get_var_double(ncid,varid,lon) +ret=nf_close(ncid) +ret=nf_open("inputs/Pfafstetter.nc",0,ncid) +ret=nf_inq_varid(ncid,"lat",varid) +ret=nf_get_var_double(ncid,varid,lat) +ret=nf_close(ncid) +ret=nf_open("inputs/Pfafstetter.nc",0,ncid) +ret=nf_inq_varid(ncid,"data",varid) +ret=nf_get_var_int(ncid,varid,landocean) +ret=nf_close(ncid) + allocate(Greenland(nlon_G,nlat_G)) allocate(lon_G(nlon_G),lat_G(nlat_G)) -call read_ncfile_double1d("inputs/GreenlandID_30s.nc","lon",lon_G,nlon_G) -call read_ncfile_double1d("inputs/GreenlandID_30s.nc","lat",lat_G,nlat_G) -call read_ncfile_int2d("inputs/GreenlandID_30s.nc","data",Greenland,nlon_G,nlat_G) +ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) +ret=nf_inq_varid(ncid,"lon",varid) +ret=nf_get_var_double(ncid,varid,lon_G) +ret=nf_close(ncid) +ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) +ret=nf_inq_varid(ncid,"lat",varid) +ret=nf_get_var_double(ncid,varid,lat_G) +ret=nf_close(ncid) +ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) +ret=nf_inq_varid(ncid,"data",varid) +ret=nf_get_var_int(ncid,varid,Greenland) +ret=nf_close(ncid) + where(Greenland/=-9999.and.(landocean(loni_min:loni_max,lati_min:lati_max)<=id_landend.or.& landocean(loni_min:loni_max,lati_min:lati_max)==id_glac ))& @@ -58,9 +66,9 @@ program main enddo enddo - - -call create_ncfile_int2d("outputs/Pfafstetter_Greenland_real.nc","data",landocean,lon,lat,nlon,nlat) - +open(30,file="outputs/Pfafstetter_Greenland_real",form="unformatted") +do j = 1,nlat + write (30) landocean(:,j) +end do end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 index 04ee53ec0..4ce2c990f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 @@ -1,11 +1,8 @@ program main +use constant,only : nc,ns,ng implicit none -integer,parameter :: nc=291284 -integer,parameter :: ns=22612 -integer,parameter :: ng=525 - integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall integer :: k,i,ntot diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index c67b25edf..bdae54f92 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -1,22 +1,16 @@ program main -use omp_lib -use rwncfile +use constant,only : nc,nl,ng,nlon=>nlon1m,nlat=>nlat1m implicit none +include 'netcdf.inc' -integer,parameter :: nc=291284 -integer,parameter :: nl=22087 -integer,parameter :: ng=525 -integer,parameter :: nlon=21600 -integer,parameter :: nlat=10800 - -real*8,allocatable :: lon(:),lat(:),long(:),latg(:),lons(:),lats(:) +real*8,allocatable :: lon(:),lat(:),long(:),latg(:),lons(:),lats(:) integer,allocatable :: catchind(:,:) -real,allocatable :: acah(:,:) +real,allocatable :: acah(:,:) integer,allocatable :: down(:),sx(:),sy(:),msk(:) -real,allocatable :: acas(:) +real,allocatable :: acas(:) -integer :: id,xi,yi,i,k,xis,yis,ntot +integer :: id,xi,yi,i,k,xis,yis,ntot,ncid,ret,varid ntot=nl+ng allocate(catchind(nlon,nlat),acah(nlon,nlat)) @@ -24,11 +18,25 @@ program main allocate(sx(nc),sy(nc),acas(nc),down(nc),msk(nc)) allocate(long(ng),latg(ng),lons(ntot),lats(ntot)) -call read_ncfile_double1d("inputs/CatchIndex.nc","lon",lon,nlon) -call read_ncfile_double1d("inputs/CatchIndex.nc","lat",lat,nlat) -call read_ncfile_int2d("inputs/CatchIndex.nc","data",catchind,nlon,nlat) -call read_ncfile_real2d("inputs/HydroSHEDS_drainage_area.nc","data",acah,nlon,nlat) +ret=nf_open("inputs/CatchIndex.nc",0,ncid) +ret=nf_inq_varid(ncid,"lon",varid) +ret=nf_get_var_double(ncid,varid,lon) +ret=nf_close(ncid) +ret=nf_open("inputs/CatchIndex.nc",0,ncid) +ret=nf_inq_varid(ncid,"lat",varid) +ret=nf_get_var_double(ncid,varid,lat) +ret=nf_close(ncid) + +ret=nf_open("inputs/CatchIndex.nc",0,ncid) +ret=nf_inq_varid(ncid,"data",varid) +ret=nf_get_var_int(ncid,varid,catchind) +ret=nf_close(ncid) + +ret=nf_open("inputs/HydroSHEDS_drainage_area.nc",0,ncid) +ret=nf_inq_varid(ncid,"data",varid) +ret=nf_get_var_real(ncid,varid,acah) +ret=nf_close(ncid) open(77,file="inputs/downstream_1D_new_noadj.txt") read(77,*)down @@ -61,7 +69,6 @@ program main lats(k)=lat(sy(i)) endif enddo -!print *,k open(77,file="inputs/Greenland_outlets_lat.txt") read(77,*)latg diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 index 61b81bb9d..6387fc956 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 @@ -1,20 +1,16 @@ program main -use omp_lib - +use constant,only : nall,ns implicit none -integer,parameter :: nall=291809 -integer,parameter :: nc=22612 - integer, allocatable, dimension(:) :: id_final,id_outlet,msk -integer,allocatable,dimension(:) :: lati_outlet,loni_outlet -integer,allocatable,dimension(:) :: lati_full,loni_full +integer,allocatable,dimension(:) :: lati_outlet,loni_outlet +integer,allocatable,dimension(:) :: lati_full,loni_full integer :: i,j -allocate(id_final(nall),id_outlet(nc),msk(nall),& - lati_outlet(nc),loni_outlet(nc),lati_full(nall),loni_full(nall)) +allocate(id_final(nall),id_outlet(ns),msk(nall),& + lati_outlet(ns),loni_outlet(ns),lati_full(nall),loni_full(nall)) open(77,file="outputs/Pfaf_finalID_all.txt") read(77,*)id_final @@ -33,7 +29,7 @@ program main do i=1,nall !if(mod(i,1000)==0) print *,i if(msk(id_final(i)).eq.2)then - do j=1,nc + do j=1,ns if(id_outlet(j).eq.id_final(i))then lati_full(i)=lati_outlet(j) loni_full(i)=loni_outlet(j) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 index e2f9d33d3..8627f2292 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -1,13 +1,9 @@ program main -use rwncfile +use constant,only : ns,nlon,nlat implicit none -integer,parameter :: ns=22612 -integer,parameter :: nlat=21600 -integer,parameter :: nlon=43200 - -real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis +real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis integer,allocatable,dimension(:) :: lati,loni integer :: i,temp(1) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/ncdioMod.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/ncdioMod.f90 deleted file mode 100755 index fdc73b0c5..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/ncdioMod.f90 +++ /dev/null @@ -1,2582 +0,0 @@ - -module ncdio - use netcdf -!----------------------------------------------------------------------- -!BOP -! -! !MODULE: ncdioMod -! -! !DESCRIPTION: -! Generic interfaces to write fields to netcdf files -! -! !USES: -! -! !PUBLIC TYPES: - implicit none - include 'netcdf.inc' !netcdf库文件 - save - public :: check_ret ! checks return status of netcdf calls - public :: check_var ! determine if variable is on netcdf file - public :: check_dim ! validity check on dimension - public :: ncd_defvar -! -! !REVISION HISTORY: -! -!EOP -! -! !PRIVATE METHODS: -! - interface ncd_iolocal - module procedure ncd_iolocal_int_1d - module procedure ncd_iolocal_real_1d - module procedure ncd_iolocal_double_1d - module procedure ncd_iolocal_int_2d - module procedure ncd_iolocal_real_2d - module procedure ncd_iolocal_double_2d - end interface - - interface ncd_ioglobal - module procedure ncd_ioglobal_int_var - module procedure ncd_ioglobal_real_var - module procedure ncd_ioglobal_double_var - module procedure ncd_ioglobal_int_1d - module procedure ncd_ioglobal_real_1d - module procedure ncd_ioglobal_double_1d - module procedure ncd_ioglobal_byte_2d - module procedure ncd_ioglobal_short_2d - module procedure ncd_ioglobal_int_2d - module procedure ncd_ioglobal_long_2d - module procedure ncd_ioglobal_real_2d - module procedure ncd_ioglobal_double_2d - module procedure ncd_ioglobal_int_3d - module procedure ncd_ioglobal_short_3d - module procedure ncd_ioglobal_real_3d - module procedure ncd_ioglobal_double_3d - end interface - - private :: endrun - logical, public, parameter :: nc_masterproc = .true. ! proc 0 logical for printing msgs - -!----------------------------------------------------------------------- - -contains - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: check_dim -! -! !INTERFACE: - subroutine check_dim(ncid, dimname, value) -! -! !DESCRIPTION: -! Validity check on dimension -! 判断nc文件中指定维数dimname的长度与指定值value相等 -! !ARGUMENTS: - implicit none - integer, intent(in) :: ncid - character(len=*), intent(in) :: dimname - integer, intent(in) :: value -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: dimid, dimlen ! temporaries -!----------------------------------------------------------------------- - - call check_ret(nf_inq_dimid (ncid, trim(dimname), dimid), 'check_dim') !查询维数的代码 - call check_ret(nf_inq_dimlen (ncid, dimid, dimlen), 'check_dim') !查询维数的大小 - if (dimlen /= value) then - write (6,*) 'CHECK_DIM error: mismatch of input dimension ',dimlen, & - ' with expected value ',value,' for variable ',trim(dimname) - call endrun() - end if - - end subroutine check_dim - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: check_var -! -! !INTERFACE: - subroutine check_var(ncid, varname, varid, readvar) -! 判断NC文件中是否含有名为varname的变量，如有则返回readvar=true且返回变量号varid，否则报错。 -! !DESCRIPTION: -! Check if variable is on netcdf file -! -! !ARGUMENTS: - implicit none - integer, intent(in) :: ncid - character(len=*), intent(in) :: varname - integer, intent(out) :: varid - logical, intent(out) :: readvar -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: ret ! return value -!----------------------------------------------------------------------- - - readvar = .true. - if (nc_masterproc) then - ret = nf_inq_varid (ncid, varname, varid) - if (ret/=NF_NOERR) then - write(6,*)'CHECK_VAR: variable ',trim(varname),' is not on initial dataset' - readvar = .false. - end if - end if - end subroutine check_var - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: check_ret -! -! !INTERFACE: - subroutine check_ret(ret, calling) -! 返回NC文件操作是否正确 -! !DESCRIPTION: -! Check return status from netcdf call -! -! !ARGUMENTS: - implicit none - integer, intent(in) :: ret - character(len=*) :: calling -! -! !REVISION HISTORY: -! -!EOP -!----------------------------------------------------------------------- - - if (ret /= NF_NOERR) then !如果打开nc文件出错，则提示出错信息 - write(6,*)'netcdf error from ',trim(calling) - call endrun(nf_strerror(ret)) - end if - - end subroutine check_ret - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_defvar -! -! !INTERFACE: - subroutine ncd_defvar(ncid, varname, xtype, & - dim1name, dim2name, dim3name, dim4name, dim5name, & - long_name, units, cell_method, missing_value, fill_value, & - imissing_value, ifill_value) -! 定义NC变量， -! ncid--NC文件号 -! varname--变量名称 -! xtype--变量类型 -! dim1name--第一维的名称 -! dim2name--第二维的名称 -! dim3name--第三维的名称 -! dim4name--第四维的名称 -! dim5name--第五维的名称 -! long_name--属性-变量的完整名称 -! units--属性-变量的单位 -! cell_method--属性-值的来源说明 -! missing_value--属性-实型缺测值 -! fill_value--属性-实型的缺省值 -! imissing_value--属性-整型的缺测值 -! ifill_value--属性-整型的缺省值 -! !DESCRIPTION: -! Define a netcdf variable -! -! !ARGUMENTS: - implicit none - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer , intent(in) :: xtype ! external type - character(len=*), intent(in), optional :: dim1name ! dimension name - character(len=*), intent(in), optional :: dim2name ! dimension name - character(len=*), intent(in), optional :: dim3name ! dimension name - character(len=*), intent(in), optional :: dim4name ! dimension name - character(len=*), intent(in), optional :: dim5name ! dimension name - character(len=*), intent(in), optional :: long_name ! attribute - character(len=*), intent(in), optional :: units ! attribute - character(len=*), intent(in), optional :: cell_method ! attribute - real , intent(in), optional :: missing_value ! attribute for real - real , intent(in), optional :: fill_value ! attribute for real - integer , intent(in), optional :: imissing_value ! attribute for int - integer , intent(in), optional :: ifill_value ! attribute for int -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: n ! indices - integer :: ndims ! dimension counter - integer :: dimid(5) ! dimension ids - integer :: varid ! variable id - integer :: itmp ! temporary - character(len=256) :: str ! temporary - character(len=32) :: subname='NCD_DEFVAR_REAL' ! subroutine name -!----------------------------------------------------------------------- - - if (.not. nc_masterproc) return - - ! Determine dimension ids for variable - - dimid(:) = 0 - ndims=0 - if (present(dim1name)) then - ndims=ndims+1 - call check_ret(nf_inq_dimid(ncid, dim1name, dimid(ndims)), subname) - end if - if (present(dim2name)) then - ndims=ndims+1 - call check_ret(nf_inq_dimid(ncid, dim2name, dimid(ndims)), subname) - end if - if (present(dim3name)) then - ndims=ndims+1 - call check_ret(nf_inq_dimid(ncid, dim3name, dimid(ndims)), subname) - end if - if (present(dim4name)) then - ndims=ndims+1 - call check_ret(nf_inq_dimid(ncid, dim4name, dimid(ndims)), subname) - end if - if (present(dim5name)) then - ndims=ndims+1 - call check_ret(nf_inq_dimid(ncid, dim5name, dimid(ndims)), subname) - end if - - - ! Define variable - - if (present(dim1name) .or. present(dim2name) .or. present(dim3name) .or. & - present(dim4name) .or. present(dim5name)) then - call check_ret(nf_def_var(ncid, trim(varname), xtype, ndims, dimid(1:ndims), varid), subname) - else - call check_ret(nf_def_var(ncid, varname, xtype, 0, 0, varid), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - if (present(cell_method)) then - str = 'time: ' // trim(cell_method) - call check_ret(nf_put_att_text(ncid, varid, 'cell_method', len_trim(str), trim(str)), subname) - end if - if (present(fill_value)) then - call check_ret(nf_put_att_real(ncid, varid, '_FillValue', xtype, 1, fill_value), subname) - end if - if (present(missing_value)) then - call check_ret(nf_put_att_real(ncid, varid, 'missing_value', xtype, 1, missing_value), subname) - end if - if (present(ifill_value)) then - call check_ret(nf_put_att_int(ncid, varid, '_FillValue', xtype, 1, ifill_value), subname) - end if - if (present(imissing_value)) then - call check_ret(nf_put_att_int(ncid, varid, 'missing_value', xtype, 1, imissing_value), subname) - end if - - end subroutine ncd_defvar - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_iolocal_int_1d -! -! !INTERFACE: - - subroutine ncd_iolocal_int_1d(varname, data, flag, ncid, & - lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & - long_name, units, readvar) -! 读/写局部一维实型变量:将一笔资料阵列写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! lb_lon--经向的起始号 -! lb_lat--纬向的起始号 -! lb_lvl--层次的起始号 -! lb_t--时间的起始号 -! ub_lon--经向的起始号 -! ub_lat--纬向的起始号 -! ub_lvl--层次的起始号 -! ub_t--时间的起始号 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O for 1d int field -! -! !USES: -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - integer , intent(inout) :: data(:) ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - integer , optional, intent(in) :: lb_lon ! start for longitude - integer , optional, intent(in) :: lb_lat ! start for latitute sizes - integer , optional, intent(in) :: lb_lvl ! start for level size - integer , optional, intent(in) :: lb_t ! start for time size - integer , optional, intent(in) :: ub_lon ! start for longitude - integer , optional, intent(in) :: ub_lat ! start for latitute sizes - integer , optional, intent(in) :: ub_lvl ! start for level size - integer , optional, intent(in) :: ub_t ! start for time size - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! variable id - integer :: ndim ! dimension counter - integer :: start(4) ! starting indices for netcdf field - integer :: count(4) ! count values for netcdf field - character(len=32) :: inq_name ! inquid variable name - character(len=8) :: inq_xtype ! inquid variable type - integer :: inq_ndims ! inquid variable dimention - integer :: inq_dimids(4) ! inquid variable dimention id - character(len=255) :: inq_natts ! inquid variable attachment - character(len=32) :: subname='NCD_IOLOCAL_INT_1D' ! subroutine name - logical :: varpresent ! if true, variable is on tape -!----------------------------------------------------------------------- - - ! Write field as 1d field - if (flag == 'write') then - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - ! Write 1d field - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_put_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if ! end of if-nc_masterproc block - ! Read field as 1d field - else if (flag == 'read') then - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - !read data - call check_ret(nf_get_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - else - call endrun('the varibal does not difined!',subname) - end if - end if - if (present(readvar)) readvar = varpresent - end if - - end subroutine ncd_iolocal_int_1d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_iolocal_real_1d -! -! !INTERFACE: - subroutine ncd_iolocal_real_1d(varname, data, flag, ncid, & - lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & - long_name, units, readvar) -! 读/写局部一维实型变量:将一笔资料阵列写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! lb_lon--经向的起始号 -! lb_lat--纬向的起始号 -! lb_lvl--层次的起始号 -! lb_t--时间的起始号 -! ub_lon--经向的起始号 -! ub_lat--纬向的起始号 -! ub_lvl--层次的起始号 -! ub_t--时间的起始号 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O for 1d int field -! -! !USES: -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - real, intent(inout) :: data(:) ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - integer , optional, intent(in) :: lb_lon ! start for longitude - integer , optional, intent(in) :: lb_lat ! start for latitute sizes - integer , optional, intent(in) :: lb_lvl ! start for level size - integer , optional, intent(in) :: lb_t ! start for time size - integer , optional, intent(in) :: ub_lon ! start for longitude - integer , optional, intent(in) :: ub_lat ! start for latitute sizes - integer , optional, intent(in) :: ub_lvl ! start for level size - integer , optional, intent(in) :: ub_t ! start for time size - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! variable id - integer :: ndim ! dimension counter - integer :: start(4) ! starting indices for netcdf field - integer :: count(4) ! count values for netcdf field - character(len=32) :: inq_name ! inquid variable name - character(len=8) :: inq_xtype ! inquid variable type - integer :: inq_ndims ! inquid variable dimention - integer :: inq_dimids(4) ! inquid variable dimention id - character(len=255) :: inq_natts ! inquid variable attachment - character(len=32) :: subname='NCD_IOLOCAL_REAL_1D' ! subroutine name - logical :: varpresent ! if true, variable is on tape -!----------------------------------------------------------------------- - - ! Write field as 1d field - if (flag == 'write') then - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - ! Write 1d field - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_put_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if ! end of if-nc_masterproc block - ! Read field as 1d field - else if (flag == 'read') then - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - !read data - call check_ret(nf_get_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - else - call endrun('the varibal does not difined!',subname) - end if - end if - if (present(readvar)) readvar = varpresent - end if - - end subroutine ncd_iolocal_real_1d -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_iolocal_real_1d -! -! !INTERFACE: - subroutine ncd_iolocal_double_1d(varname, data, flag, ncid, & - lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & - long_name, units, readvar) -! 读/写局部一维实型变量:将一笔资料阵列写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! lb_lon--经向的起始号 -! lb_lat--纬向的起始号 -! lb_lvl--层次的起始号 -! lb_t--时间的起始号 -! ub_lon--经向的起始号 -! ub_lat--纬向的起始号 -! ub_lvl--层次的起始号 -! ub_t--时间的起始号 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O for 1d int field -! -! !USES: -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - real*8, intent(inout) :: data(:) ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - integer , optional, intent(in) :: lb_lon ! start for longitude - integer , optional, intent(in) :: lb_lat ! start for latitute sizes - integer , optional, intent(in) :: lb_lvl ! start for level size - integer , optional, intent(in) :: lb_t ! start for time size - integer , optional, intent(in) :: ub_lon ! start for longitude - integer , optional, intent(in) :: ub_lat ! start for latitute sizes - integer , optional, intent(in) :: ub_lvl ! start for level size - integer , optional, intent(in) :: ub_t ! start for time size - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! variable id - integer :: ndim ! dimension counter - integer :: start(4) ! starting indices for netcdf field - integer :: count(4) ! count values for netcdf field - character(len=32) :: inq_name ! inquid variable name - character(len=8) :: inq_xtype ! inquid variable type - integer :: inq_ndims ! inquid variable dimention - integer :: inq_dimids(4) ! inquid variable dimention id - character(len=255) :: inq_natts ! inquid variable attachment - character(len=32) :: subname='NCD_IOLOCAL_REAL_1D' ! subroutine name - logical :: varpresent ! if true, variable is on tape -!----------------------------------------------------------------------- - - ! Write field as 1d field - if (flag == 'write') then - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - ! Write 1d field - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_put_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if ! end of if-nc_masterproc block - ! Read field as 1d field - else if (flag == 'read') then - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - !read data - call check_ret(nf_get_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - else - call endrun('the varibal does not difined!',subname) - end if - end if - if (present(readvar)) readvar = varpresent - end if - - end subroutine ncd_iolocal_double_1d -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_iolocal_int_2d -! -! !INTERFACE: - subroutine ncd_iolocal_int_2d(varname, data, flag, ncid, & - lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & - long_name, units, readvar) -! 读/写局部二维整型变量:将一笔资料阵列写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! lb_lon--经向的起始号 -! lb_lat--纬向的起始号 -! lb_lvl--层次的起始号 -! lb_t--时间的起始号 -! ub_lon--经向的起始号 -! ub_lat--纬向的起始号 -! ub_lvl--层次的起始号 -! ub_t--时间的起始号 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O for 2d real field -! -! !USES: -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - integer , intent(inout) :: data(:,:) ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - integer , optional, intent(in) :: lb_lon ! start for longitude - integer , optional, intent(in) :: lb_lat ! start for latitute sizes - integer , optional, intent(in) :: lb_lvl ! start for level size - integer , optional, intent(in) :: lb_t ! start for time size - integer , optional, intent(in) :: ub_lon ! start for longitude - integer , optional, intent(in) :: ub_lat ! start for latitute sizes - integer , optional, intent(in) :: ub_lvl ! start for level size - integer , optional, intent(in) :: ub_t ! start for time size - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! variable id - integer :: ndim ! dimension counter - integer :: start(4) ! starting indices for netcdf field - integer :: count(4) ! count values for netcdf field - character(len=32) :: inq_name ! inquid variable name - character(len=8) :: inq_xtype ! inquid variable type - integer :: inq_ndims ! inquid variable dimention - integer :: inq_dimids(4) ! inquid variable dimention id - character(len=255) :: inq_natts ! inquid variable attachment - character(len=32) :: subname='NCD_IOLOCAL_INT_2D' ! subroutine name - logical :: varpresent ! if true, variable is on tape -!----------------------------------------------------------------------- - - ! Write field as 2d field - if (flag == 'write') then - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - ! Write 2d field - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_put_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if ! end of if-nc_masterproc block - ! Read field as 1d field - else if (flag == 'read') then - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_get_vara_int(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - else - call endrun('the varibal does not difined!',subname) - end if - end if - if (present(readvar)) readvar = varpresent - end if - - end subroutine ncd_iolocal_int_2d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_iolocal_real_2d -! -! !INTERFACE: - subroutine ncd_iolocal_real_2d(varname, data, flag, ncid, & - lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & - long_name, units, readvar) -! 读/写局部二维实型变量:将一笔资料阵列写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! lb_lon--经向的起始号 -! lb_lat--纬向的起始号 -! lb_lvl--层次的起始号 -! lb_t--时间的起始号 -! ub_lon--经向的起始号 -! ub_lat--纬向的起始号 -! ub_lvl--层次的起始号 -! ub_t--时间的起始号 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O for 2d real field -! -! !USES: -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - real, intent(inout) :: data(:,:) ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - integer , optional, intent(in) :: lb_lon ! start for longitude - integer , optional, intent(in) :: lb_lat ! start for latitute sizes - integer , optional, intent(in) :: lb_lvl ! start for level size - integer , optional, intent(in) :: lb_t ! start for time size - integer , optional, intent(in) :: ub_lon ! start for longitude - integer , optional, intent(in) :: ub_lat ! start for latitute sizes - integer , optional, intent(in) :: ub_lvl ! start for level size - integer , optional, intent(in) :: ub_t ! start for time size - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! variable id - integer :: ndim ! dimension counter - integer :: start(4) ! starting indices for netcdf field - integer :: count(4) ! count values for netcdf field - character(len=32) :: inq_name ! inquid variable name - character(len=8) :: inq_xtype ! inquid variable type - integer :: inq_ndims ! inquid variable dimention - integer :: inq_dimids(4) ! inquid variable dimention id - character(len=255) :: inq_natts ! inquid variable attachment - character(len=32) :: subname='NCD_IOLOCAL_REAL_2D' ! subroutine name - logical :: varpresent ! if true, variable is on tape -!----------------------------------------------------------------------- - - ! Write field as 2d field - if (flag == 'write') then - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - ! Write 2d field - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_put_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if ! end of if-nc_masterproc block - ! Read field as 1d field - else if (flag == 'read') then - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_get_vara_real(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - else - call endrun('the varibal does not difined!',subname) - end if - end if - if (present(readvar)) readvar = varpresent - end if - - end subroutine ncd_iolocal_real_2d - - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_iolocal_real_2d -! -! !INTERFACE: - subroutine ncd_iolocal_double_2d(varname, data, flag, ncid, & - lb_lon, lb_lat, lb_lvl, lb_t, ub_lon, ub_lat, ub_lvl, ub_t, & - long_name, units, readvar) -! 读/写局部二维实型变量:将一笔资料阵列写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! lb_lon--经向的起始号 -! lb_lat--纬向的起始号 -! lb_lvl--层次的起始号 -! lb_t--时间的起始号 -! ub_lon--经向的起始号 -! ub_lat--纬向的起始号 -! ub_lvl--层次的起始号 -! ub_t--时间的起始号 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O for 2d real field -! -! !USES: -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - real*8, intent(inout) :: data(:,:) ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - integer , optional, intent(in) :: lb_lon ! start for longitude - integer , optional, intent(in) :: lb_lat ! start for latitute sizes - integer , optional, intent(in) :: lb_lvl ! start for level size - integer , optional, intent(in) :: lb_t ! start for time size - integer , optional, intent(in) :: ub_lon ! start for longitude - integer , optional, intent(in) :: ub_lat ! start for latitute sizes - integer , optional, intent(in) :: ub_lvl ! start for level size - integer , optional, intent(in) :: ub_t ! start for time size - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! variable id - integer :: ndim ! dimension counter - integer :: start(4) ! starting indices for netcdf field - integer :: count(4) ! count values for netcdf field - character(len=32) :: inq_name ! inquid variable name - character(len=8) :: inq_xtype ! inquid variable type - integer :: inq_ndims ! inquid variable dimention - integer :: inq_dimids(4) ! inquid variable dimention id - character(len=255) :: inq_natts ! inquid variable attachment - character(len=32) :: subname='NCD_IOLOCAL_REAL_2D' ! subroutine name - logical :: varpresent ! if true, variable is on tape -!----------------------------------------------------------------------- - - ! Write field as 2d field - if (flag == 'write') then - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - ! Write 2d field - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_put_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if ! end of if-nc_masterproc block - ! Read field as 1d field - else if (flag == 'read') then - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - ndim=0 - count=1 - if (present(lb_lon) .and. present(ub_lon)) then - ndim=ndim+1 - start(ndim)=lb_lon - count(ndim)=ub_lon-lb_lon+1 - else if(present(lb_lon) .neqv. present(ub_lon))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lat)) then - ndim=ndim+1 - start(ndim)=lb_lat - count(ndim)=ub_lat-lb_lat+1 - else if(present(lb_lat) .neqv. present(ub_lat))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_lvl)) then - ndim=ndim+1 - start(ndim)=lb_lvl - count(ndim)=ub_lvl-lb_lvl+1 - else if(present(lb_lvl) .neqv. present(ub_lvl))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - if (present(lb_t)) then - ndim=ndim+1 - start(ndim)=lb_t - count(ndim)=ub_t-lb_t+1 - else if(present(lb_t) .neqv. present(lb_t))then - call endrun('must specify the low and up boundary at the same time!',subname) - endif - - if ((.not. present(lb_lon)) .and. (.not. present(lb_lat)) .and. & - (.not. present(lb_lvl)) .and. (.not. present(lb_t))) then - call endrun('must specify one dimention!',subname) - endif - - call check_ret(nf_get_vara_double(ncid, varid, start(1:ndim), count(1:ndim), data), subname) - else - call endrun('the varibal does not difined!',subname) - end if - end if - if (present(readvar)) readvar = varpresent - end if - - end subroutine ncd_iolocal_double_2d - - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_int_var -! -! !INTERFACE: - subroutine ncd_ioglobal_int_var(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局零维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O of integer variable -! - -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - integer , intent(inout) :: data ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - integer , optional, intent(in) :: nt ! time sample index - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: ier ! error status - integer :: dimid(1) ! dimension id - integer :: start(1), count(1) ! output bounds - integer :: varid ! variable id - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_INT_VAR' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = nt; count(1) = 1 - call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_int(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_int_var - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_var -! -! !INTERFACE: - subroutine ncd_ioglobal_real_var(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局零维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O of real variable -! - -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - real , intent(inout) :: data ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: ier ! error status - integer :: dimid(1) ! dimension id - integer :: start(1), count(1) ! output bounds - integer :: varid ! variable id - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_VAR' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = nt; count(1) = 1 - call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_real(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_real(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_real_var - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_var -! -! !INTERFACE: - subroutine ncd_ioglobal_double_var(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局零维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! I/O of real variable -! - -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: varname ! variable name - real*8 , intent(inout) :: data ! local decomposition data - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: ier ! error status - integer :: dimid(1) ! dimension id - integer :: start(1), count(1) ! output bounds - integer :: varid ! variable id - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_VAR' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = nt; count(1) = 1 - call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_double(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_double(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_double_var - -!---------------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_int_1d -! -! !INTERFACE: - subroutine ncd_ioglobal_int_1d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局一维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! Master I/O for 1d integer data -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer , intent(inout) :: data(:) ! local decomposition data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(2), ndims ! dimension ids - integer :: start(2), count(2) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_INT_1D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data) - start(2) = nt; count(2) = 1 - call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_int(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_int_1d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_1d -! -! !INTERFACE: - subroutine ncd_ioglobal_real_1d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局一维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! Master I/O for 1d real data -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - real , intent(inout) :: data(:) ! local decomposition input data - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: ier ! error code - integer :: dimid(2), ndims ! dimension ids - integer :: start(2), count(2) ! output bounds - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_1D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data) - start(2) = nt; count(2) = 1 - call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) - else -! call check_ret(nf_put_var_real(ncid, varid, data), subname) -call check_ret(nf_put_var_real(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_real(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_real_1d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_1d -! -! !INTERFACE: - subroutine ncd_ioglobal_double_1d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局一维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! Master I/O for 1d real data -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - real*8 , intent(inout) :: data(:) ! local decomposition input data - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: ier ! error code - integer :: dimid(2), ndims ! dimension ids - integer :: start(2), count(2) ! output bounds - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_1D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data) - start(2) = nt; count(2) = 1 - call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) - else -! call check_ret(nf_put_var_double(ncid, varid, data), subname) -call check_ret(nf_put_var_double(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_double(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_double_1d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_int_2d -! -! !INTERFACE: - subroutine ncd_ioglobal_int_2d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 2d integer array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer , intent(inout) :: data(:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(3), ndims ! dimension ids - integer :: start(3), count(3) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_2D_INT_IO' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = nt; count(3) = 1 - call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_int(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_int_2d - -!----------------------------------------------------------------------- - -!BOP -! -! !IROUTINE: ncd_ioglobal_int_2d -! -! !INTERFACE: - subroutine ncd_ioglobal_long_2d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 2d integer array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer*8 , intent(inout) :: data(:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(3), ndims ! dimension ids - integer :: start(3), count(3) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_2D_INT_IO' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = nt; count(3) = 1 - call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_int(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_long_2d - -!----------------------------------------------------------------------- - -!BOP -! -! !IROUTINE: ncd_ioglobal_byte_2d -! -! !INTERFACE: - subroutine ncd_ioglobal_byte_2d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 2d integer array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - byte, intent(inout) :: data(:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(3), ndims ! dimension ids - integer :: start(3), count(3) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_2D_INT1_IO' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = nt; count(3) = 1 - call check_ret(nf_put_vara_int1(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int1(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_int1(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_byte_2d -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_short_2d -! -! !INTERFACE: - subroutine ncd_ioglobal_short_2d(varname, data, flag, ncid, long_name, units, nt, readvar) -! 读/写全局二维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 2d integer array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer*2, intent(inout) :: data(:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(3), ndims ! dimension ids - integer :: start(3), count(3) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_2D_INT2_IO' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = nt; count(3) = 1 - call check_ret(nf_put_vara_int2(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int2(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_int2(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_short_2d -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_2d -! -! !INTERFACE: - subroutine ncd_ioglobal_real_2d(varname, data, flag, & - ncid, long_name, units, nt, readvar) -! 读/写全局二维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! long_name--属性-变量全称 -! units--属性-变量单位 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 2d real array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - real , intent(inout) :: data(:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: ier ! error code - integer :: dimid(3), ndims ! dimension ids - integer :: start(3), count(3) ! output bounds - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_2D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = nt; count(3) = 1 -! call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) -call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_real(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_real(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_real_2d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_2d -! -! !INTERFACE: - subroutine ncd_ioglobal_double_2d(varname, data, flag, & - ncid, long_name, units, nt, readvar) -! 读/写全局二维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! long_name--属性-变量全称 -! units--属性-变量单位 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 2d real array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - real*8 , intent(inout) :: data(:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: ier ! error code - integer :: dimid(3), ndims ! dimension ids - integer :: start(3), count(3) ! output bounds - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_2D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = nt; count(3) = 1 -! call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) -call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_double(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - call check_ret(nf_get_var_double(ncid, varid, data), subname) - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_double_2d -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_short_3d -! -! !INTERFACE: - subroutine ncd_ioglobal_short_3d(varname, data, flag, & - ncid, long_name, units, nt, readvar) -! 读/写全局三维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! long_name--属性-变量全称 -! units--属性-变量单位 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 3d integer array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer*2 , intent(inout) :: data(:,:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(4), ndims ! dimension ids - integer :: start(4), count(4) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_3D_INT2_IO' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_put_vara_int2(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int2(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_get_vara_int2(ncid, varid, start, count, data), subname) - else - call check_ret(nf_get_var_int2(ncid, varid, data), subname) - end if - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_short_3d -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_int_3d -! -! !INTERFACE: - subroutine ncd_ioglobal_int_3d(varname, data, flag, & - ncid, long_name, units, nt, readvar) -! 读/写全局三维整型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! long_name--属性-变量全称 -! units--属性-变量单位 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 3d integer array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - integer , intent(inout) :: data(:,:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: dimid(4), ndims ! dimension ids - integer :: start(4), count(4) ! output bounds - integer :: ier ! error code - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_3D_INT_IO' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_put_vara_int(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_int(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_get_vara_int(ncid, varid, start, count, data), subname) - else - call check_ret(nf_get_var_int(ncid, varid, data), subname) - end if - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_int_3d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_3d -! -! !INTERFACE: - subroutine ncd_ioglobal_real_3d(varname, data, flag, & - ncid, long_name, units, nt, readvar) -! 读/写全局三维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! long_name--属性-变量全称 -! units--属性-变量单位 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 3d real array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - real, intent(inout) :: data(:,:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: ier ! error code - integer :: dimid(4), ndims ! dimension ids - integer :: start(4), count(4) ! output bounds - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_3D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_put_vara_real(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_real(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_get_vara_real(ncid, varid, start, count, data), subname) - else - call check_ret(nf_get_var_real(ncid, varid, data), subname) - end if - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_real_3d - -!----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: ncd_ioglobal_real_3d -! -! !INTERFACE: - subroutine ncd_ioglobal_double_3d(varname, data, flag, & - ncid, long_name, units, nt, readvar) -! 读/写全局三维实型变量:将所有的资料阵列均写入档案中 -! varname--变量名 -! data--变量存储数组 -! long_name--属性-变量全称 -! units--属性-变量单位 -! flag--读/写的标记 -! ncid--NC文件对应的文件号 -! nt--时间步 -! readvar--所读取的变量是否存在于该NC文件中 -! !DESCRIPTION: -! netcdf I/O of global 3d real array -! -! !ARGUMENTS: - implicit none - character(len=*), intent(in) :: flag ! 'read' or 'write' - integer , intent(in) :: ncid ! input unit - character(len=*), intent(in) :: varname ! variable name - real*8, intent(inout) :: data(:,:,:) ! local decomposition input data - character(len=*), optional, intent(in) :: long_name ! variable long name - character(len=*), optional, intent(in) :: units ! variable units - logical , optional, intent(out):: readvar ! true => variable is on initial dataset (read only) - integer , optional, intent(in) :: nt ! time sample index -! -! !REVISION HISTORY: -! -!EOP -! -! !LOCAL VARIABLES: - integer :: varid ! netCDF variable id - integer :: ier ! error code - integer :: dimid(4), ndims ! dimension ids - integer :: start(4), count(4) ! output bounds - logical :: varpresent ! if true, variable is on tape - character(len=32) :: subname='NCD_IOGLOBAL_REAL_3D' ! subroutine name -!----------------------------------------------------------------------- - - if (flag == 'write') then - - if (nc_masterproc) then - call check_ret(nf_inq_varid(ncid, varname, varid), subname) - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_put_vara_double(ncid, varid, start, count, data), subname) - else - call check_ret(nf_put_var_double(ncid, varid, data), subname) - end if - if (present(long_name)) then - call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) - end if - if (present(units)) then - call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) - end if - end if - - else if (flag == 'read') then - - if (nc_masterproc) then - call check_var(ncid, varname, varid, varpresent) - if (varpresent) then - if (present(nt)) then - start(1) = 1; count(1) = size(data, dim=1) - start(2) = 1; count(2) = size(data, dim=2) - start(3) = 1; count(3) = size(data, dim=3) - start(4) = nt; count(4) = 1 - call check_ret(nf_get_vara_double(ncid, varid, start, count, data), subname) - else - call check_ret(nf_get_var_double(ncid, varid, data), subname) - end if - else - call endrun('the varibal does not difined!',subname) - endif - end if - if (present(readvar)) readvar = varpresent - - end if - - end subroutine ncd_ioglobal_double_3d - -!----------------------------------------------------------------------- -!BOP -! !IROUTINE: endrun -! -! !INTERFACE: -subroutine endrun(msg,subname) -! -! !DESCRIPTION: -! Abort the model for abnormal termination - implicit none -! !ARGUMENTS: - character(len=*), intent(in), optional :: msg ! string to be printed - character(len=*), intent(in), optional :: subname ! subname - - if (present (subname)) then - write(6,*) 'ERROR in subroutine :', trim(subname) - end if - - if (present (msg)) then - write(6,*)'ENDRUN:', msg - else - write(6,*) 'ENDRUN: called without a message string' - end if - - stop -end subroutine endrun - -end module ncdio - - - - - - diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet_land.f90 deleted file mode 100755 index 238a985db..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/read_riveroutlet_land.f90 +++ /dev/null @@ -1,29 +0,0 @@ -program main - -use omp_lib -use rwncfile - -implicit none - -character(len=100) :: lonfile="outlet_sinkx_allcat_2d.nc" -character(len=100) :: latfile="outlet_sinky_allcat_2d.nc" -integer, parameter :: nx=43200, ny=21600 -integer, allocatable :: lats(:,:), lons(:,:) -integer i,j - -allocate(lats(nx,ny), lons(nx,ny)) - -call read_ncfile_int2d("outputs/"//trim(latfile),"data",lats,nx,ny) -call read_ncfile_int2d("outputs/"//trim(lonfile),"data",lons,nx,ny) - - -open(30,file="Outlet_latlon.43200x21600",form="unformatted") - - -do j = 1, ny - write (30) lons(:,j) - write (30) lats(:,j) -end do - - -end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py new file mode 100644 index 000000000..94a5ce312 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py @@ -0,0 +1,60 @@ +#!/usr/bin/env python3 + +import os +import subprocess + +input_path = "/discover/nobackup/yzeng3/work/outlets/inputs" +netcdf_path = "/discover/nobackup/yzeng3/apps/netcdf-4.2.1.1" + +# Remove files and directories +os.system("rm -rf inputs >& /dev/null") +os.system("rm -rf outputs >& /dev/null") +os.system("rm -f *.mod >& /dev/null") +os.system("rm -f *.out >& /dev/null") +os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") + +# Create directories and symbolic links +os.makedirs("inputs", exist_ok=True) +os.makedirs("outputs", exist_ok=True) +for file in os.listdir(input_path): + os.symlink(os.path.join(input_path, file), os.path.join("inputs", file)) + +# Build and run Fortran programs +programs = [ + "get_outlets_catchindex", + "get_outlets_land", + "get_sinkxy_land", + "get_outlets_land_allcat", + "get_landocean_Greenland_real", + "Pfaf_to_2d_30s_land", +] + +for program in programs: + print(f"Building {program} ...") + #subprocess.run(["./build", program]) + subprocess.run(f"ifort constant.f90 {program}.f90 -I{netcdf_path}/include -L{netcdf_path}/lib -lnetcdf -lnetcdff -o {program}.out",shell=True) + +out_programs = [ + "get_outlets_catchindex.out", + "get_outlets_land.out", + "get_sinkxy_land.out", + "get_outlets_land_allcat.out", + "get_landocean_Greenland_real.out", + "Pfaf_to_2d_30s_land.out", +] + +for out_program in out_programs: + print(f"running {out_program}") + subprocess.run(f"./{out_program}",shell=True) + +print("Outlet_latlon.43200x21600 created!") + +# Clean up +print("Removing temporary input/output files ...") +os.system("rm -rf outputs") +os.system("rm -rf inputs") +print("Removing *.out files ...") +os.system("rm -f *.out") +os.system("rm -f *.mod") + + diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh deleted file mode 100755 index 502a92832..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.sh +++ /dev/null @@ -1,56 +0,0 @@ -#!/bin/bash -set -e - -INPUT=/discover/nobackup/yzeng3/work/outlets/inputs - -module load comp/intel/2021.3.0 - -rm -rf inputs >& /dev/null -rm -rf outputs >& /dev/null -rm -f *.mod >& /dev/null -rm -f *.out >& /dev/null -rm -f Outlet_latlon.43200x21600 >& /dev/null - -mkdir -p inputs outputs -ln -s ${INPUT}/* inputs - -echo "Building get_outlets_catchindex.f90 ..." -./build get_outlets_catchindex.f90 -echo "Building get_outlets_land.f90 ..." -./build get_outlets_land.f90 -echo "Building get_sinkxy_land.f90 ..." -./build get_sinkxy_land.f90 -echo "Building get_outlets_land_allcat.f90 ..." -./build get_outlets_land_allcat.f90 -echo "Building get_landocean_Greenland_real.f90 ..." -./build get_landocean_Greenland_real.f90 -echo "Building Pfaf_to_2d_30s_land.f90 ..." -./build Pfaf_to_2d_30s_land.f90 -echo "Building read_riveroutlet_land.f90 ..." -./build read_riveroutlet_land.f90 - -echo "Getting the outlet locations in land:" -echo "running get_outlets_catchindex.out" -./get_outlets_catchindex.out -echo "running get_outlets_land.out" -./get_outlets_land.out -echo "running get_sinkxy_land.out" -./get_sinkxy_land.out - -echo "Finalizing the outlet files for use in the mk_bcs:" -echo "running get_outlets_land_allcat.out" -./get_outlets_land_allcat.out -echo "running get_landocean_Greenland_real.out" -./get_landocean_Greenland_real.out -echo "running Pfaf_to_2d_30s_land.out" -./Pfaf_to_2d_30s_land.out -echo "running read_riveroutlet_land.out" -./read_riveroutlet_land.out -echo "Outlet_latlon.43200x21600 created!" - -echo "Removing temporary input/output files ..." -rm -rf outputs -rm -rf inputs -echo "Removing *.out files ..." -rm -f *.out -rm -f *.mod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 deleted file mode 100755 index dcab17e30..000000000 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/rwncMod.f90 +++ /dev/null @@ -1,530 +0,0 @@ -module rwncfile - - use ncdio - implicit none - - public :: read_ncfile_real1d - public :: read_ncfile_double1d - - public :: read_ncfile_int2d - public :: read_ncfile_int3d - public :: read_ncfile_real2d - public :: read_ncfile_real3d - public :: read_ncfile_double2d - public :: read_ncfile_double3d - - public :: write_ncfile_int2d - public :: write_ncfile_real2d - public :: write_ncfile_double2d - - public :: create_ncfile_byte2d - public :: create_ncfile_short2d - public :: create_ncfile_short3d - public :: create_ncfile_int3d - public :: create_ncfile_int2d - public :: create_ncfile_int2d_fill - - public :: create_ncfile_long2d - public :: create_ncfile_real2d - public :: create_ncfile_real3d - public :: create_ncfile_double2d - - contains -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_real1d(filename,varname,var,n) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: n - real, intent(inout) :: var(n) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_real(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_real1d -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_double1d(filename,varname,var,n) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: n - real*8, intent(inout) :: var(n) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_double(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_double1d -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_int2d(filename,varname,var,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - integer, intent(inout) :: var(nlon,nlat) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_int(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_int2d -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_int3d(filename,varname,var,nlon,nlat,nlev) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat, nlev - integer, intent(inout) :: var(nlon,nlat,nlev) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_int(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_int3d -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_real2d(filename,varname,var,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - real, intent(inout) :: var(nlon,nlat) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_real(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_real2d -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_real3d(filename,varname,var,nlon,nlat,nlev) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat, nlev - real, intent(inout) :: var(nlon,nlat,nlev) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_real(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_real3d -!------------------------------------------------------------------------------------------ - subroutine read_ncfile_double2d(filename,varname,var,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - real*8, intent(inout) :: var(nlon,nlat) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_double(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_double2d - - - subroutine read_ncfile_double3d(filename,varname,var,nlon,nlat,nlev) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat, nlev - real*8, intent(inout) :: var(nlon,nlat,nlev) - - character(len=4) :: subname="read" - integer :: ncid, varid - - call check_ret(nf_open(filename,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,varname,varid),subname) - call check_ret(nf_get_var_double(ncid,varid,var),subname) - call check_ret(nf_close(ncid), subname) - - end subroutine read_ncfile_double3d -!------------------------------------------------------------------------------------------ - subroutine write_ncfile_int2d(filename,varname,var,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - integer, intent(inout) :: var(nlon,nlat) - - character(len=4) :: subname="write" - integer :: ncid, varid, omode - - call check_ret(nf_open(filename, nf_write, ncid), subname) - call check_ret(nf_set_fill(ncid, nf_nofill, omode), subname) - call ncd_ioglobal(varname=varname, data=var, ncid=ncid, flag='write') - call check_ret(nf_sync(ncid), subname) - call check_ret(nf_close(ncid), subname) - end subroutine write_ncfile_int2d -!------------------------------------------------------------------------------------------ - subroutine write_ncfile_real2d(filename,varname,var,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - real, intent(inout) :: var(nlon,nlat) - - character(len=4) :: subname="write" - integer :: ncid, varid, omode - - call check_ret(nf_open(filename, nf_write, ncid), subname) - call check_ret(nf_set_fill(ncid, nf_nofill, omode), subname) - call ncd_ioglobal(varname=varname, data=var, ncid=ncid, flag='write') - call check_ret(nf_sync(ncid), subname) - call check_ret(nf_close(ncid), subname) - end subroutine write_ncfile_real2d -!------------------------------------------------------------------------------------------ - subroutine write_ncfile_double2d(filename,varname,var,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - real*8, intent(inout) :: var(nlon,nlat) - - character(len=4) :: subname="write" - integer :: ncid, varid, omode - - call check_ret(nf_open(filename, nf_write, ncid), subname) - call check_ret(nf_set_fill(ncid, nf_nofill, omode), subname) - call ncd_ioglobal(varname=varname, data=var, ncid=ncid, flag='write') - call check_ret(nf_sync(ncid), subname) - call check_ret(nf_close(ncid), subname) - end subroutine write_ncfile_double2d -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_int2d(filename,varname,var,lon,lat,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - integer, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int, dim1name='lon', & - dim2name='lat', long_name=varname, units='unitless', fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_int2d - - subroutine create_ncfile_int2d_fill(filename,varname,var,lon,lat,nlon,nlat,fillvalue) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - integer, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - real,intent(in) :: fillvalue - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int, dim1name='lon', & - dim2name='lat', long_name=varname, units='unitless', fill_value=fillvalue) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_int2d_fill - - subroutine create_ncfile_long2d(filename,varname,var,lon,lat,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - integer*8, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), NF_NETCDF4, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon',& - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat',& - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int64, dim1name='lon',& - dim2name='lat', long_name=varname, units='unitless',fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_long2d - -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_byte2d(filename,varname,var,lon,lat,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - byte, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_byte, dim1name='lon', & - dim2name='lat', long_name=varname, units='unitless',fill_value=-128. ) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_byte2d - -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_short2d(filename,varname,var,lon,lat,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - integer*2, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_short, dim1name='lon', & - dim2name='lat', long_name=varname, units='unitless',fill_value=-9999. ) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_short2d - - -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_real2d(filename,varname,var,lon,lat,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - real, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_float, dim1name='lon', & - dim2name='lat', long_name=varname, units='unitless', fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_real2d - -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_short3d(filename,varname,var,lon,lat,lev,nlon,nlat,nlev) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat, nlev - integer*2, intent(inout) :: var(nlon,nlat,nlev) - real*8, intent(in) :: lon(nlon),lat(nlat),lev(nlev) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat), lev1(nlev) - - lon1=lon - lat1=lat - lev1=lev - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call check_ret(nf_def_dim(ncid,'lev',nlev, dimid), subname) - - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname='lev', xtype=nf_double, dim2name='lev', & - long_name='level', units='unitless') - - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_short, dim1name='lon', & - dim2name='lat', dim3name='lev', long_name=varname, units='unitless', fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lev', data=lev1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_short3d -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_int3d(filename,varname,var,lon,lat,lev,nlon,nlat,nlev) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat, nlev - integer, intent(inout) :: var(nlon,nlat,nlev) - real*8, intent(in) :: lon(nlon),lat(nlat),lev(nlev) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat), lev1(nlev) - - lon1=lon - lat1=lat - lev1=lev - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call check_ret(nf_def_dim(ncid,'lev',nlev, dimid), subname) - - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname='lev', xtype=nf_double, dim2name='lev', & - long_name='level', units='unitless') - - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_int, dim1name='lon', & - dim2name='lat', dim3name='lev', long_name=varname, units='unitless', fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lev', data=lev1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_int3d -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_real3d(filename,varname,var,lon,lat,lev,nlon,nlat,nlev) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat, nlev - real, intent(inout) :: var(nlon,nlat,nlev) - real*8, intent(in) :: lon(nlon),lat(nlat),lev(nlev) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat), lev1(nlev) - - lon1=lon - lat1=lat - lev1=lev - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call check_ret(nf_def_dim(ncid,'lev',nlev, dimid), subname) - - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname='lev', xtype=nf_double, dim2name='lev', & - long_name='level', units='unitless') - - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_float, dim1name='lon', & - dim2name='lat', dim3name='lev', long_name=varname, units='unitless', fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lev', data=lev1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_real3d - -!------------------------------------------------------------------------------------------ - subroutine create_ncfile_double2d(filename,varname,var,lon,lat,nlon,nlat) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: varname - integer, intent(in) :: nlon, nlat - real*8, intent(inout) :: var(nlon,nlat) - real*8, intent(in) :: lon(nlon),lat(nlat) - - character(len=4) :: subname="create" - integer :: ncid, varid, dimid - real*8 :: lon1(nlon), lat1(nlat) - - lon1=lon - lat1=lat - call check_ret(nf_create(trim(filename), nf_clobber, ncid), subname) - call check_ret(nf_def_dim(ncid,'lon',nlon, dimid), subname) - call check_ret(nf_def_dim(ncid,'lat',nlat, dimid), subname) - call ncd_defvar(ncid=ncid, varname='lon', xtype=nf_double, dim1name='lon', & - long_name='longtitude', units='degrees_east') - call ncd_defvar(ncid=ncid, varname='lat', xtype=nf_double, dim2name='lat', & - long_name='latitude', units='degrees_north') - call ncd_defvar(ncid=ncid, varname=varname, xtype=nf_double, dim1name='lon', & - dim2name='lat', long_name=varname, units='unitless', fill_value=-9999.) - call check_ret(nf_enddef(ncid), subname) - call ncd_ioglobal(varname='lon', data=lon1, flag='write',ncid=ncid) - call ncd_ioglobal(varname='lat', data=lat1, flag='write',ncid=ncid) - call ncd_ioglobal(varname=varname, data=var, flag='write',ncid=ncid) - call check_ret(nf_close(ncid), subname) - end subroutine create_ncfile_double2d -!------------------------------------------------------------------------------------------ -end module rwncfile - From 01acd34e5e2ec4d8383f8e1991e544f378376705 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 21 Nov 2023 17:58:50 -0500 Subject: [PATCH 14/55] change nf_ to nf90_ --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 382768079..e01a0c598 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -637,10 +637,10 @@ subroutine read_oceanModel_mapl(mask_file,wetMask,nx,ny) !print *, "Reading ocean model mask from : ", mask_file - call check_ret(nf_open(mask_file,0,ncid),subname) - call check_ret(nf_inq_varid(ncid,"mask",varid),subname) - call check_ret(nf_get_var_real(ncid,varid,wetMask),subname) - call check_ret(nf_close(ncid), subname) + call check_ret(nf90_open(mask_file,0,ncid),subname) + call check_ret(nf90_inq_varid(ncid,"mask",varid),subname) + call check_ret(nf90_get_var(ncid,varid,wetMask),subname) + call check_ret(nf90_close(ncid), subname) end subroutine read_oceanModel_mapl !------------------------------------------------------------------------ From 66b7add8cc3914e434f9308273226ede7452f261 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 21 Nov 2023 20:32:55 -0500 Subject: [PATCH 15/55] use netcdf in the baselib of GEOS --- .../Utils/Raster/preproc/routing/constant.f90 | 0 .../Utils/Raster/preproc/routing/readme.txt | 0 .../Utils/Raster/preproc/routing/run.py | 21 ++++++++++++++++--- 3 files changed, 18 insertions(+), 3 deletions(-) mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt mode change 100644 => 100755 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt old mode 100644 new mode 100755 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py old mode 100644 new mode 100755 index 94a5ce312..bf22e38f7 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py @@ -4,7 +4,7 @@ import subprocess input_path = "/discover/nobackup/yzeng3/work/outlets/inputs" -netcdf_path = "/discover/nobackup/yzeng3/apps/netcdf-4.2.1.1" +baselib = "/discover/swdev/gmao_SIteam/Baselibs/ESMA-Baselibs-7.8.1/x86_64-pc-linux-gnu/ifort_2021.6.0-intelmpi_2021.6.0/Linux" # Remove files and directories os.system("rm -rf inputs >& /dev/null") @@ -13,6 +13,16 @@ os.system("rm -f *.out >& /dev/null") os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") +# Link basedir +base_lib_path = baselib + "/lib" +for file in os.listdir(base_lib_path): + os.system(f"rm -f {file} >& /dev/null") + os.symlink(os.path.join(base_lib_path, file), os.path.join(os.getcwd(), file)) +base_inc_path = baselib + "/include/netcdf" +for file in os.listdir(base_inc_path): + os.system(f"rm -f {file} >& /dev/null") + os.symlink(os.path.join(base_inc_path, file), os.path.join(os.getcwd(), file)) + # Create directories and symbolic links os.makedirs("inputs", exist_ok=True) os.makedirs("outputs", exist_ok=True) @@ -32,7 +42,7 @@ for program in programs: print(f"Building {program} ...") #subprocess.run(["./build", program]) - subprocess.run(f"ifort constant.f90 {program}.f90 -I{netcdf_path}/include -L{netcdf_path}/lib -lnetcdf -lnetcdff -o {program}.out",shell=True) + subprocess.run(f"ifort constant.f90 {program}.f90 -lnetcdf -lnetcdff -o {program}.out",shell=True) out_programs = [ "get_outlets_catchindex.out", @@ -56,5 +66,10 @@ print("Removing *.out files ...") os.system("rm -f *.out") os.system("rm -f *.mod") - +base_lib_path = os.getenv("BASELIB") + "/lib/" +for file in os.listdir(base_lib_path): + os.system(f"rm -f {file} >& /dev/null") +base_inc_path = os.getenv("BASELIB") + "/include/netcdf" +for file in os.listdir(base_inc_path): + os.system(f"rm -f {file} >& /dev/null") From a77594f08ad53f334dd8cca24539037c570419fa Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Sun, 3 Dec 2023 15:48:56 -0500 Subject: [PATCH 16/55] mk_runofftbl can read more general resolution name --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 111 ++++++++++-------- 1 file changed, 63 insertions(+), 48 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index e01a0c598..3235c938a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -339,69 +339,84 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) integer,allocatable,dimension(:,:) :: ns_map real*8,allocatable,dimension(:) :: lat_lnd,lon_lnd integer :: i,j,l,k,status,type,np,flag,flag2 + integer :: px,plats,plate,plons,plone,plonss,pocns,pocne - do i=1,100 - if(file(i:i).eq."T".and.file(i+1:i+1).eq."M")then + nx_str="" + ny_str="" + px=0;plats=0;plate=0;plons=0;plone=0;plonss=0 + do i=100,1,-1 + if(file(i:i).eq."x")then + px=i exit endif enddo - file_ocn="" - file_ocn(1:13)=file(i:i+12) - !print *,trim(file_ocn) - file_ocn_lnd="" - file_ocn_lnd(1:13)=file_ocn - file_ocn_lnd(14:25)="-Pfafstetter" - !print *,trim(file_ocn_lnd) + do i=px+1,100 + if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& + .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then + plats=i + exit + endif + enddo + do i=plats+1,100 + if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& + .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then + plate=i-1 + exit + endif + enddo + ny_str(1:plate-plats+1)=file(plats:plate) + !print *,trim(ny_str) + nstr1=plate-plats+1 + + plone=px-1 + do i=plone,1,-1 + if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& + .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then + plonss=i+1 + exit + endif + enddo + do i=plonss,plone + if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& + .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then + plons=i + exit + endif + enddo + nx_str(1:plone-plons+1)=file(plons:plone) + !print *,trim(nx_str) + nstr2=plone-plons+1 + - nx_str="" - ny_str="" - res_MAPL="" - flag=0 - k=1 do i=1,100 - if(flag==0)then - if(file_ocn(i:i).ne."T".and.file_ocn(i:i).ne."M".and.file_ocn(i:i).ne."0")then - flag=1 - nx_str(k:k)=file_ocn(i:i) - k=k+1 - endif - else if(flag==1)then - if(file_ocn(i:i).eq."x")exit - nx_str(k:k)=file_ocn(i:i) - k=k+1 + if(file(i:i).eq."_")then + pocns=i+1 + exit endif enddo -! print *,trim(nx_str) - nstr1=k-1 -! print *,nstr1 - flag=0 - flag2=0 - k=1 do i=1,100 - IF(flag2==1)THEN - if(flag==0)then - if(file_ocn(i:i).ne."T".and.file_ocn(i:i).ne."M".and.file_ocn(i:i).ne."0")then - flag=1 - ny_str(k:k)=file_ocn(i:i) - k=k+1 - endif - else if(flag==1)then - if(file_ocn(i:i).eq." ")exit - ny_str(k:k)=file_ocn(i:i) - k=k+1 + if(file(i:i+10).eq."Pfafstetter")then + pocne=i-2 + exit endif - ELSE - if(file_ocn(i:i).eq."x")flag2=1 - ENDIF enddo -! print *,trim(ny_str) - nstr2=k-1 -! print *,nstr2 + + file_ocn="" + file_ocn(1:pocne-pocns+1)=file(pocns:pocne) + !print *,trim(file_ocn) + file_ocn_lnd="" + file_ocn_lnd(1:pocne-pocns+1)=file_ocn(1:pocne-pocns+1) + file_ocn_lnd(pocne-pocns+2:pocne-pocns+13)="-Pfafstetter" + !print *,trim(file_ocn_lnd) + + res_MAPL="" res_MAPL(1:nstr1+nstr2+1)=trim(nx_str)//"x"//trim(ny_str) !print *,trim(res_MAPL) read(nx_str,*)nx_MAPL - read(ny_str,*)ny_MAPL + read(ny_str,*)ny_MAPL + !print *,nx_MAPL + !print *,ny_MAPL fileT_ocn = "til/"//trim(file_ocn)//".til" ! input fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input From 07fd40264482dfdaab8e95cb193b9fdef7778830 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 5 Dec 2023 10:48:04 -0500 Subject: [PATCH 17/55] input path changed to a public directory --- .../GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py index bf22e38f7..15f9b8fca 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py @@ -3,7 +3,7 @@ import os import subprocess -input_path = "/discover/nobackup/yzeng3/work/outlets/inputs" +input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing" baselib = "/discover/swdev/gmao_SIteam/Baselibs/ESMA-Baselibs-7.8.1/x86_64-pc-linux-gnu/ifort_2021.6.0-intelmpi_2021.6.0/Linux" # Remove files and directories From 26d4c94c8ac147eac8a8c99061ac51769f387051 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Wed, 6 Dec 2023 10:14:10 -0500 Subject: [PATCH 18/55] using netcdf in Discover --- .../Utils/Raster/preproc/routing/run.py | 20 ++----------------- 1 file changed, 2 insertions(+), 18 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py index 15f9b8fca..fa73f1cb8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py @@ -4,7 +4,7 @@ import subprocess input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing" -baselib = "/discover/swdev/gmao_SIteam/Baselibs/ESMA-Baselibs-7.8.1/x86_64-pc-linux-gnu/ifort_2021.6.0-intelmpi_2021.6.0/Linux" +netcdf_path = "/usr/local/other/netcdf4/4.1.2/gcc-4.8.5" # Remove files and directories os.system("rm -rf inputs >& /dev/null") @@ -13,16 +13,6 @@ os.system("rm -f *.out >& /dev/null") os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") -# Link basedir -base_lib_path = baselib + "/lib" -for file in os.listdir(base_lib_path): - os.system(f"rm -f {file} >& /dev/null") - os.symlink(os.path.join(base_lib_path, file), os.path.join(os.getcwd(), file)) -base_inc_path = baselib + "/include/netcdf" -for file in os.listdir(base_inc_path): - os.system(f"rm -f {file} >& /dev/null") - os.symlink(os.path.join(base_inc_path, file), os.path.join(os.getcwd(), file)) - # Create directories and symbolic links os.makedirs("inputs", exist_ok=True) os.makedirs("outputs", exist_ok=True) @@ -42,7 +32,7 @@ for program in programs: print(f"Building {program} ...") #subprocess.run(["./build", program]) - subprocess.run(f"ifort constant.f90 {program}.f90 -lnetcdf -lnetcdff -o {program}.out",shell=True) + subprocess.run(f"gfortran constant.f90 {program}.f90 -I{netcdf_path}/include -L{netcdf_path}/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lz -lsz -ldl -o {program}.out",shell=True) out_programs = [ "get_outlets_catchindex.out", @@ -66,10 +56,4 @@ print("Removing *.out files ...") os.system("rm -f *.out") os.system("rm -f *.mod") -base_lib_path = os.getenv("BASELIB") + "/lib/" -for file in os.listdir(base_lib_path): - os.system(f"rm -f {file} >& /dev/null") -base_inc_path = os.getenv("BASELIB") + "/include/netcdf" -for file in os.listdir(base_inc_path): - os.system(f"rm -f {file} >& /dev/null") From 41a8a36182a41e7a11c244d9631e52431977a80a Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Wed, 6 Dec 2023 11:54:56 -0500 Subject: [PATCH 19/55] mk_runofftbl.F90 now can read MOM5 resolutions as well. --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 3235c938a..3dab5d652 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -622,7 +622,7 @@ subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) integer,intent(in) :: nt,nlon,nlat integer,intent(in) :: t2loni(nt),t2lati(nt) -character(len=*) :: res_MAPL +character(len=*),intent(in) :: res_MAPL integer,intent(out) :: msk_tile(nt) real,allocatable,dimension(:,:) :: msk_MAPL @@ -631,7 +631,7 @@ subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) !print *,"running mask_MAPL_1d() ..." allocate(msk_MAPL(nlon,nlat)) -call read_oceanModel_mapl("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ocean/MOM6/"//trim(res_MAPL)//"/MAPL_Tripolar.nc",msk_MAPL,nlon,nlat) +call read_oceanModel_mapl(res_MAPL,msk_MAPL,nlon,nlat) do i=1,nt msk_tile(i)=int(msk_MAPL(t2loni(i),t2lati(i))) @@ -641,18 +641,22 @@ subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) end subroutine mask_MAPL_1d !------------------------------------------------------------------------ - subroutine read_oceanModel_mapl(mask_file,wetMask,nx,ny) + subroutine read_oceanModel_mapl(res_MAPL,wetMask,nx,ny) implicit none - character(len=*), intent(in) :: mask_file + character(len=*), intent(in) :: res_MAPL integer,intent(in) :: nx, ny real :: wetMask(nx,ny) - integer :: ncid, varid + integer :: ncid, varid, ret character(len=4) :: subname="read" !print *, "Reading ocean model mask from : ", mask_file - call check_ret(nf90_open(mask_file,0,ncid),subname) + + ret=nf90_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ocean/MOM6/"//trim(res_MAPL)//"/MAPL_Tripolar.nc",0,ncid) + if(ret /= NF_NOERR)then + call check_ret(nf90_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ocean/MOM5/"//trim(res_MAPL)//"/MAPL_Tripolar.nc",0,ncid),subname) + endif call check_ret(nf90_inq_varid(ncid,"mask",varid),subname) call check_ret(nf90_get_var(ncid,varid,wetMask),subname) call check_ret(nf90_close(ncid), subname) @@ -664,7 +668,7 @@ subroutine check_ret(ret, calling) integer, intent(in) :: ret character(len=*) :: calling - if (ret /= NF_NOERR) then !脠莽鹿没麓貌驴陋nc脦脛录镁鲁枚麓铆拢卢脭貌脤谩脢戮鲁枚麓铆脨脜脧垄 + if (ret /= NF_NOERR) then write(6,*)'netcdf error from ',trim(calling) call endrun(nf_strerror(ret)) end if From cf6a9d0e2378a6e2a7c86e82e8e3f848dd14ff8a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 11 Dec 2023 10:17:58 -0500 Subject: [PATCH 20/55] build routing bcs executable without installation --- .../Utils/Raster/preproc/CMakeLists.txt | 2 +- .../Raster/preproc/routing/CMakeLists.txt | 26 +++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt index 15405d696..d4eca3cfc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/CMakeLists.txt @@ -1 +1 @@ -esma_add_subdirectories (soil) +esma_add_subdirectories (soil routing) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt new file mode 100644 index 000000000..a828c56d6 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt @@ -0,0 +1,26 @@ +esma_set_this () + +set(srcs + constant.f90 +) + +set (exe_srcs + get_landocean_Greenland_real.f90 + get_outlets_land_allcat.f90 + get_sinkxy_land.f90 + get_outlets_catchindex.f90 + get_outlets_land.f90 + Pfaf_to_2d_30s_land.f90 +) + +esma_add_library (${this} + SRCS ${srcs} +) + +foreach (src ${exe_srcs}) + string (REGEX REPLACE ".f90" ".x" exe ${src}) + ecbuild_add_executable ( + TARGET ${exe} + SOURCES ${src} + LIBS ${this} NetCDF::NetCDF_Fortran MPI::MPI_Fortran) +endforeach () From e0093903bd706a2896678986871cf301f81206dc Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 12 Dec 2023 14:55:46 -0500 Subject: [PATCH 21/55] run.py will not build code, only run exe now. --- .../Utils/Raster/preproc/routing/run.py | 36 +++++++++++-------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py index fa73f1cb8..9f4a3c406 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py @@ -4,13 +4,15 @@ import subprocess input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing" -netcdf_path = "/usr/local/other/netcdf4/4.1.2/gcc-4.8.5" +#netcdf_path = "/usr/local/other/netcdf4/4.1.2/gcc-4.8.5" +install_path = "../../../../../../../../../../../install/bin" # Remove files and directories os.system("rm -rf inputs >& /dev/null") os.system("rm -rf outputs >& /dev/null") -os.system("rm -f *.mod >& /dev/null") -os.system("rm -f *.out >& /dev/null") +#os.system("rm -f *.mod >& /dev/null") +#os.system("rm -f *.out >& /dev/null") +os.system("rm -f *.x >& /dev/null") os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") # Create directories and symbolic links @@ -19,7 +21,7 @@ for file in os.listdir(input_path): os.symlink(os.path.join(input_path, file), os.path.join("inputs", file)) -# Build and run Fortran programs +# Link and run Fortran programs programs = [ "get_outlets_catchindex", "get_outlets_land", @@ -29,18 +31,21 @@ "Pfaf_to_2d_30s_land", ] -for program in programs: - print(f"Building {program} ...") +#for program in programs: +# print(f"Building {program} ...") #subprocess.run(["./build", program]) - subprocess.run(f"gfortran constant.f90 {program}.f90 -I{netcdf_path}/include -L{netcdf_path}/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lz -lsz -ldl -o {program}.out",shell=True) +# subprocess.run(f"gfortran constant.f90 {program}.f90 -I{netcdf_path}/include -L{netcdf_path}/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lz -lsz -ldl -o {program}.out",shell=True) +current_working_directory = os.getcwd() +for program in programs: + os.symlink(os.path.join(install_path, program+".x"), os.path.join(current_working_directory, program+".x")) out_programs = [ - "get_outlets_catchindex.out", - "get_outlets_land.out", - "get_sinkxy_land.out", - "get_outlets_land_allcat.out", - "get_landocean_Greenland_real.out", - "Pfaf_to_2d_30s_land.out", + "get_outlets_catchindex.x", + "get_outlets_land.x", + "get_sinkxy_land.x", + "get_outlets_land_allcat.x", + "get_landocean_Greenland_real.x", + "Pfaf_to_2d_30s_land.x", ] for out_program in out_programs: @@ -54,6 +59,7 @@ os.system("rm -rf outputs") os.system("rm -rf inputs") print("Removing *.out files ...") -os.system("rm -f *.out") -os.system("rm -f *.mod") +#os.system("rm -f *.out") +os.system("rm -f *.x") +#os.system("rm -f *.mod") From 9fcc82b3e669e46734302618f9aa016109a07f53 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 13 Dec 2023 13:39:52 -0500 Subject: [PATCH 22/55] add NOINSTALL option to routing bc executables --- .../Utils/Raster/preproc/routing/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt index a828c56d6..9cc4ddcbf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt @@ -22,5 +22,6 @@ foreach (src ${exe_srcs}) ecbuild_add_executable ( TARGET ${exe} SOURCES ${src} + NOINSTALL LIBS ${this} NetCDF::NetCDF_Fortran MPI::MPI_Fortran) endforeach () From 440a97f19952cb36dab33c41957e691b59ba3b36 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 13 Dec 2023 14:29:18 -0500 Subject: [PATCH 23/55] simplify running script in build directory --- .../Raster/preproc/routing/CMakeLists.txt | 6 ++-- .../preproc/routing/Pfaf_to_2d_30s_land.f90 | 2 +- .../routing/get_landocean_Greenland_real.f90 | 4 +-- .../routing/get_outlets_catchindex.f90 | 4 +-- .../preproc/routing/get_outlets_land.f90 | 2 +- .../routing/get_outlets_land_allcat.f90 | 2 +- .../preproc/routing/get_sinkxy_land.f90 | 4 +-- .../{constant.f90 => routing_constant.f90} | 4 +-- .../routing/{run.py => run_routing.py} | 29 ++----------------- 9 files changed, 17 insertions(+), 40 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{constant.f90 => routing_constant.f90} (96%) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{run.py => run_routing.py} (50%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt index 9cc4ddcbf..f681019ae 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt @@ -1,7 +1,7 @@ esma_set_this () set(srcs - constant.f90 + routing_constant.f90 ) set (exe_srcs @@ -16,7 +16,6 @@ set (exe_srcs esma_add_library (${this} SRCS ${srcs} ) - foreach (src ${exe_srcs}) string (REGEX REPLACE ".f90" ".x" exe ${src}) ecbuild_add_executable ( @@ -25,3 +24,6 @@ foreach (src ${exe_srcs}) NOINSTALL LIBS ${this} NetCDF::NetCDF_Fortran MPI::MPI_Fortran) endforeach () + +# copy to the build directory +configure_file(run_routing.py run_routing.py) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 index 4016b5e57..e5b290ad2 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 @@ -1,6 +1,6 @@ program main -use constant,only : nall,nlon,nlat +use routing_constant,only : nall,nlon,nlat implicit none character(len=100) :: var1="outlet_sinky_allcat" diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 786a8cc0f..2617d30f6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -1,6 +1,6 @@ program main -use constant, only : nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,id_glac,id_lake,id_landend +use routing_constant, only : nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,id_glac,id_lake,id_landend implicit none include 'netcdf.inc' @@ -71,4 +71,4 @@ program main write (30) landocean(:,j) end do -end \ No newline at end of file +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 index 4ce2c990f..566a85dc7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 @@ -1,6 +1,6 @@ program main -use constant,only : nc,ns,ng +use routing_constant,only : nc,ns,ng implicit none integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall @@ -46,4 +46,4 @@ program main -end \ No newline at end of file +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index bdae54f92..fc5d0b1ea 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -1,6 +1,6 @@ program main -use constant,only : nc,nl,ng,nlon=>nlon1m,nlat=>nlat1m +use routing_constant,only : nc,nl,ng,nlon=>nlon1m,nlat=>nlat1m implicit none include 'netcdf.inc' diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 index 6387fc956..22f61958e 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 @@ -1,6 +1,6 @@ program main -use constant,only : nall,ns +use routing_constant,only : nall,ns implicit none integer, allocatable, dimension(:) :: id_final,id_outlet,msk diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 index 8627f2292..94c36d188 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -1,6 +1,6 @@ program main -use constant,only : ns,nlon,nlat +use routing_constant,only : ns,nlon,nlat implicit none real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis @@ -39,4 +39,4 @@ program main write(88,*)loni(i) enddo -end \ No newline at end of file +end diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 similarity index 96% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 index 18abd28b8..87571b4f4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/constant.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 @@ -1,4 +1,4 @@ -module constant +module routing_constant implicit none public @@ -23,4 +23,4 @@ module constant integer,parameter :: nall=291809 !total number of catchments in land and Greenland -end module constant \ No newline at end of file +end module routing_constant diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing.py similarity index 50% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing.py index 9f4a3c406..839153a6b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing.py @@ -1,18 +1,15 @@ #!/usr/bin/env python3 +#source g5_modules before run to get the necessary env + import os import subprocess input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing" -#netcdf_path = "/usr/local/other/netcdf4/4.1.2/gcc-4.8.5" -install_path = "../../../../../../../../../../../install/bin" # Remove files and directories os.system("rm -rf inputs >& /dev/null") os.system("rm -rf outputs >& /dev/null") -#os.system("rm -f *.mod >& /dev/null") -#os.system("rm -f *.out >& /dev/null") -os.system("rm -f *.x >& /dev/null") os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") # Create directories and symbolic links @@ -21,24 +18,6 @@ for file in os.listdir(input_path): os.symlink(os.path.join(input_path, file), os.path.join("inputs", file)) -# Link and run Fortran programs -programs = [ - "get_outlets_catchindex", - "get_outlets_land", - "get_sinkxy_land", - "get_outlets_land_allcat", - "get_landocean_Greenland_real", - "Pfaf_to_2d_30s_land", -] - -#for program in programs: -# print(f"Building {program} ...") - #subprocess.run(["./build", program]) -# subprocess.run(f"gfortran constant.f90 {program}.f90 -I{netcdf_path}/include -L{netcdf_path}/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lz -lsz -ldl -o {program}.out",shell=True) -current_working_directory = os.getcwd() -for program in programs: - os.symlink(os.path.join(install_path, program+".x"), os.path.join(current_working_directory, program+".x")) - out_programs = [ "get_outlets_catchindex.x", "get_outlets_land.x", @@ -58,8 +37,4 @@ print("Removing temporary input/output files ...") os.system("rm -rf outputs") os.system("rm -rf inputs") -print("Removing *.out files ...") -#os.system("rm -f *.out") -os.system("rm -f *.x") -#os.system("rm -f *.mod") From 7c103818501600a916ec2c3b1eb0ea1a3fa4c55d Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Wed, 13 Dec 2023 19:08:10 -0500 Subject: [PATCH 24/55] Readme.txt modified, and rename the run_routing.sh to run_routing_raster.sh. --- .../Utils/Raster/preproc/routing/CMakeLists.txt | 2 +- .../Utils/Raster/preproc/routing/readme.txt | 7 ++----- .../routing/{run_routing.py => run_routing_raster.py} | 0 3 files changed, 3 insertions(+), 6 deletions(-) rename GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/{run_routing.py => run_routing_raster.py} (100%) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt index f681019ae..e687c3a4b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt @@ -26,4 +26,4 @@ foreach (src ${exe_srcs}) endforeach () # copy to the build directory -configure_file(run_routing.py run_routing.py) +configure_file(run_routing_raster.py run_routing_raster.py) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt index 7cb959ad1..c0607651b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -8,7 +8,7 @@ The river outlets are located in land or landice tiles as defined in the raster The "Outlet_latlon.43200x21600" file is the input for "mk_runofftbl.F90" in the makebcs package, which further adjusts the outlet locations to be consistent with the ocean model resolution and domain ("mk_runofftbl.F90"). -If on NCCS/Discover, the package can be run using the script "run.sh". If not on Discover, please contact yujin.zeng@nasa.gov. +If on NCCS/Discover, the package can be run using the script "run_routing_raster.py". Users may source g5_modules before run to get the necessary env. If not on Discover, please contact yujin.zeng@nasa.gov. The function for each f90 code are briefly described as follows: @@ -28,8 +28,5 @@ Assign outlet locations to all upstream catchments to create a 1d list showing t Insert the Greenland index map into the catchment index map. 6. Pfaf_to_2d_30s_land.f90: -Transform the 1d list above to a 30 arc-sec 2d map using the map of indices. - -7. read_riveroutlet_land.f90: -Transform the above 2d maps to the unformatted Fortran binary file "Outlet_latlon.43200x21600" that can be read directly by "mk_runofftbl.F90" of makebcs. +Transform the 1d list above to the unformatted Fortran binary file "Outlet_latlon.43200x21600" that can be read directly by "mk_runofftbl.F90" of makebcs. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py similarity index 100% rename from GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing.py rename to GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py From 9108c73f3ba149842bc9cdc0e7501643935f2d50 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 16 Dec 2023 10:21:42 -0500 Subject: [PATCH 25/55] cleanup of mk_runofftbl.F90: - replaced hardcoded Discover path with MAKE_BCS_INPUT_PATH - added missing intent() statements - cleaned up commented out lines - edited comments - fixed indentation - removed redundant "implicit none" statements --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 1421 +++++++++-------- 1 file changed, 716 insertions(+), 705 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 3dab5d652..ad42c8103 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -1,9 +1,9 @@ program Runoff - + use mapl_hashmod use mapl_sortmod use netcdf - + implicit none include 'netcdf.inc' @@ -11,7 +11,7 @@ program Runoff integer, allocatable :: lats(:,:), lons(:,:) integer, pointer :: rst(:,:), SortArr(:,:), key(:) integer, pointer :: srctile(:), srcweight(:), dstweight(:), dsttile(:) - real, allocatable :: SrcFraction(:), area(:), in(:), out(:) + real, allocatable :: SrcFraction(:), area(:), in(:), out(:) integer :: i,j,k,l, Hash, HashC, ii,jj,kk integer :: type, np,lnd, is,ie,ww integer :: numtrans, numclosed @@ -21,167 +21,163 @@ program Runoff character*400 :: fileLL character*400 :: MAKE_BCS_INPUT_DIR - character*5 :: C_NX, C_NY integer :: nxt, command_argument_count - character*(128) :: arg, & - Usage = "mk_runofftbl.x CF0012x6C_TM0072xTM0036-Pfafstetter", & - mapl_tp_file - - + character*(128) :: arg + character*(128) :: Usage = "mk_runofftbl.x CF0012x6C_TM0072xTM0036-Pfafstetter" + character*(128) :: mapl_tp_file + + ! ------------------------------------------------------------------ + call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/Outlet_latlon.' + + ! Read inputs ----------------------------------------------------- - -! Read inputs ----------------------------------------------------- I = command_argument_count() if (I /= 1) then - print *, " " - print *, "Wrong number of input arguments, got: ", I - print *, "Example usage with defaults: " - print *, " " - print *, trim(Usage) - print *, " " - call exit(1) + print *, " " + print *, "Wrong number of input arguments, got: ", I + print *, "Example usage with defaults: " + print *, " " + print *, trim(Usage) + print *, " " + call exit(1) end if - + nxt = 1 call get_command_argument(nxt, file) print *, " " print*, "Working with input BCs string: ", file print *, " " -! ------------------------------------------------------------------ + ! ------------------------------------------------------------------ + fileT = "til/"//trim(file)//".til" ! input fileR = "rst/"//trim(file)//".rst" ! input fileO = "til/"//trim(file)//".trn" ! output fileB = "til/"//trim(file)//".TRN" ! output - -! Read I and J indeces of river outlets. -! These should all be ocean pixels -!--------------------------------------- - -! print *, "Getting raster size from "//trim(fileT) + + ! Read I and J indices of river outlets. + ! These should all be ocean pixels + ! --------------------------------------- + + ! print *, "Getting raster size from "//trim(fileT) open(10,file=fileT, form="formatted", status="old") - + read(10,*) np, pf, nx, ny close(10) -! print *, nx, ny - + write (C_NX, '(i5.5)') NX write (C_NY, '(i5.5)') NY - + print *, "Reading outlets..." - + allocate(lats(nx,ny), lons(nx,ny),stat=status) if(status/=0) then print *, "Out of Memory" stop __LINE__ endif - + open (30,file=trim(fileLL)//C_NX//'x'//C_NY,form="unformatted",status="old") do j = 1, ny read (30) lons(:,j) read (30) lats(:,j) end do close(30) - + print *, " " print *, "Determining river outlets to ocean:" print *, "- Output file: ", fileB print *, " " call outlets_to_ocean(file,lons,lats,nx,ny) - - + open(10,file=fileT, form="formatted", status="old") - + read(10,*) np allocate(area(np), in(np), out(np)) - + out = 0.0 in = 0.0 - + do i=1,7 read(10,*) enddo - + lnd=-1 do l=1,np read(10,*) type, area(l) if(type==0 .and. lnd==-1) lnd = l-1 if(lnd<0) in(l) = 1. end do - + print *, "area of sphere = ", sum(real(area,kind=8)) print *, "area of land = ", sum(real(area*in,kind=8)) - + close(10) print *, "Number of Tiles ", np print *, "Ocean Tiles ", np-lnd print *, "Land tiles ", lnd - -! Read the raster file -!--------------------- - - print *, "Reading rst file "//trim(fileR) - + + ! Read the raster file + ! --------------------- + + print *, "Reading raster (rst) file "//trim(fileR) + open(20,file=fileR,form="unformatted",status="old") - + allocate(rst(nx,ny),stat=status) if(status/=0) then print *, "Out of Memory" stop __LINE__ endif - + do j=1,ny read(20) rst(:,j) enddo - + close(20) - + allocate(SortArr(2*lnd,3)) DstTile => SortArr(:,1) SrcTile => SortArr(:,2) SrcWeight => SortArr(:,3) - -! Hash the raster -!---------------- - + + ! Hash the raster + ! ---------------- + print *, "Hashing raster... " - + Hash = MAPL_HashCreate(1024) HashC = MAPL_HashCreate(1024) - + NumTrans=0 - + do j=1,ny -! if (mod(j,100) == 0) print *,'J=',j do i=1,nx if(rst(i,j)<=lnd) then ii = Lons(i,j) jj = lats(i,j) - + if(ii==-999 .or. jj==-999) then -! ii = i -! jj = j cycle endif - + if(ii==i .and. jj==j) then print *, '>>> Inland Ocean Point ', ii, jj, rst(i,j) stop end if - + k = MAPL_HASHIncrement(HashC,rst(i,j)) k = MAPL_HASHIncrement(Hash,rst(ii,jj),rst(i,j)) - + SrcWeight(k) = SrcWeight(k) + 1 - + if(k>NumTrans) then if(k/=NumTrans+1) then print *, NumTrans, k @@ -191,52 +187,52 @@ program Runoff SrcTile(NumTrans) = rst(i ,j ) DstTile(NumTrans) = rst(ii,jj) endif - + end if end do end do - + DstTile => SortArr(:NumTrans,1) SrcTile => SortArr(:NumTrans,2) SrcWeight => SortArr(:NumTrans,3) - + print *, "Total Transactions ", NumTrans print *, MAPL_HashSize(Hash),MAPL_HashSize(HashC) call MAPL_HashDestroy(Hash) call MAPL_HashDestroy(HashC) - -! Allocate space for transanction lists -!-------------------------------------- - + + ! Allocate space for transanction lists + ! -------------------------------------- + allocate(key(numTrans),stat=status) - + if(status/=0) then print *, "Out of Memory" stop endif - -! Sort transactions by source tile number to compute source -! fractions going into each transaction. -!---------------------------------------------------------- - + + ! Sort transactions by source tile number to compute source + ! fractions going into each transaction. + ! ---------------------------------------------------------- + print *, "Sorting transactions by source..." - + Key = SrcTile call MAPL_Sort(Key,SortArr(:NumTrans,:),DIM=1) - + print *, "Computing weights..." - + deallocate(key) allocate(SrcFraction(numTrans)) - -! Compute fractions -!------------------ - + + ! Compute fractions + ! ------------------ + is = 1 ie = 1 - + do j=2,NumTrans if(SrcTile(j)/=SrcTile(is)) then SrcFraction(is:ie) = SrcWeight (is:ie) @@ -247,667 +243,682 @@ program Runoff ie = ie + 1 end if end do - + SrcFraction(is:ie) = SrcWeight (is:ie) SrcFraction(is:ie) = SrcFraction(is:ie) / float(sum(SrcWeight(is:ie))) - + print *,"SrcWeight", sum(SrcFraction), lnd - + print *, '<<<', sum(SrcFraction*area(SrcTile)) - + SrcFraction = SrcFraction * (area(SrcTile)/area(DstTile)) - + print *, '>>>', sum(SrcFraction*area(DstTile)) - -! Write output files -!------------------- - + + ! Write output files + ! ------------------- + print *, "Writing output file..." - + open(10,file=fileO, form="formatted", status="unknown") write(10,*) NumTrans do k=1,NumTrans write(10,"(2I10,f16.8)") SrcTile(k),DstTile(k),SrcFraction(k) end do close(10) - + call write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) -! if (adjust_oceanLandSea_mask) & -! call write_route_file( fileBB, NumTrans, SrcTile, DstTile, SrcFraction) - + do j=1,NumTrans Out(DstTile(j)) = Out(DstTile(j)) + In(SrcTile(J))*SrcFraction(J) enddo print *, "area of land = ", sum(real(area*out,kind=8)) - - + print *, "Completed successfully" - + deallocate( SrcFraction) deallocate( SortArr) deallocate( rst) deallocate( area) deallocate( lats, lons) - + call exit(0) + + ! ----------------------------------------------------------------- -! ----------------------------------------------------------------- contains - + subroutine write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) - implicit none - character*100, intent(in) :: fileB - integer, intent(in) :: NumTrans - integer, pointer, intent(in) :: srctile(:), dsttile(:) - real, intent(in) :: SrcFraction(:) - - open(10,file=fileB, form="unformatted", status="unknown") - write(10) NumTrans - write(10) SrcTile - write(10) DstTile - write(10) SrcFraction - close(10) + + character*100, intent(in) :: fileB + integer, intent(in) :: NumTrans + integer, pointer, intent(in) :: srctile(:), dsttile(:) + real, intent(in) :: SrcFraction(:) + + open(10,file=fileB, form="unformatted", status="unknown") + write(10) NumTrans + write(10) SrcTile + write(10) DstTile + write(10) SrcFraction + close(10) + end subroutine write_route_file -!------------------------------------------------------------------------ -subroutine outlets_to_ocean(file,lons,lats,nx,ny) - - integer, intent(in) :: nx,ny - character(len=*) :: file - integer,intent(inout) :: lons(nx,ny),lats(nx,ny) - - integer,allocatable,dimension(:) :: lati_lnd,loni_lnd - integer,allocatable,dimension(:) :: msk1d - integer,allocatable,dimension(:,:) :: msk2d - integer,allocatable,dimension(:,:) :: mask - integer,allocatable,dimension(:,:) :: boundary - real*8, allocatable,dimension(:) :: lonsh,latsh - real*8,allocatable,dimension(:) :: lons_adj,lats_adj - integer,allocatable,dimension(:) :: lati_ocn,loni_ocn - character*100 :: file_ocn - character*100 :: fileT_ocn, fileR_ocn - character*100 :: file_ocn_lnd - character*100 :: fileT_ocn_lnd, fileR_ocn_lnd - character*100 :: res_MAPL - character*100 :: nx_str,ny_str - integer, allocatable,dimension(:,:):: rst_ocn,rst_ocn_lnd - real :: num1,num2,num3,num4 - integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh - integer, allocatable,dimension(:) :: t2lati,t2loni - real*8,allocatable,dimension(:) :: lon30s,lat30s - real*8 :: dx,dy - integer :: ns,nstr1,nstr2 - integer,allocatable,dimension(:,:) :: ns_map - real*8,allocatable,dimension(:) :: lat_lnd,lon_lnd - integer :: i,j,l,k,status,type,np,flag,flag2 - integer :: px,plats,plate,plons,plone,plonss,pocns,pocne - - nx_str="" - ny_str="" - px=0;plats=0;plate=0;plons=0;plone=0;plonss=0 - do i=100,1,-1 - if(file(i:i).eq."x")then - px=i - exit + + ! ------------------------------------------------------------------------ + + subroutine outlets_to_ocean(file,lons,lats,nx,ny) + + integer, intent(in) :: nx,ny + character(len=*) intent(in) :: file + integer, intent(inout) :: lons(nx,ny),lats(nx,ny) + + ! ----------------------------------------------------------- + + integer, allocatable, dimension(:) :: lati_lnd,loni_lnd + integer, allocatable, dimension(:) :: msk1d + integer, allocatable, dimension(:,:) :: msk2d + integer, allocatable, dimension(:,:) :: mask + integer, allocatable, dimension(:,:) :: boundary + real*8, allocatable, dimension(:) :: lonsh,latsh + real*8, allocatable, dimension(:) :: lons_adj,lats_adj + integer, allocatable, dimension(:) :: lati_ocn,loni_ocn + character*100 :: file_ocn + character*100 :: fileT_ocn, fileR_ocn + character*100 :: file_ocn_lnd + character*100 :: fileT_ocn_lnd, fileR_ocn_lnd + character*100 :: res_MAPL + character*100 :: nx_str,ny_str + integer, allocatable, dimension(:,:) :: rst_ocn,rst_ocn_lnd + real :: num1,num2,num3,num4 + integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh + integer, allocatable, dimension(:) :: t2lati,t2loni + real*8, allocatable, dimension(:) :: lon30s,lat30s + real*8 :: dx,dy + integer :: ns,nstr1,nstr2 + integer, allocatable, dimension(:,:) :: ns_map + real*8, allocatable, dimension(:) :: lat_lnd,lon_lnd + integer :: i,j,l,k,status,type,np,flag,flag2 + integer :: px,plats,plate,plons,plone,plonss,pocns,pocne + + nx_str="" + ny_str="" + px=0;plats=0;plate=0;plons=0;plone=0;plonss=0 + do i=100,1,-1 + if(file(i:i).eq."x")then + px=i + exit + endif + enddo + do i=px+1,100 + if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& + .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then + plats=i + exit + endif + enddo + do i=plats+1,100 + if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& + .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then + plate=i-1 + exit + endif + enddo + ny_str(1:plate-plats+1)=file(plats:plate) + nstr1=plate-plats+1 + + plone=px-1 + do i=plone,1,-1 + if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& + .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then + plonss=i+1 + exit + endif + enddo + do i=plonss,plone + if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& + .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then + plons=i + exit + endif + enddo + nx_str(1:plone-plons+1)=file(plons:plone) + nstr2=plone-plons+1 + + do i=1,100 + if(file(i:i).eq."_")then + pocns=i+1 + exit + endif + enddo + + do i=1,100 + if(file(i:i+10).eq."Pfafstetter")then + pocne=i-2 + exit + endif + enddo + + file_ocn="" + file_ocn(1:pocne-pocns+1)=file(pocns:pocne) + file_ocn_lnd="" + file_ocn_lnd(1:pocne-pocns+1)=file_ocn(1:pocne-pocns+1) + file_ocn_lnd(pocne-pocns+2:pocne-pocns+13)="-Pfafstetter" + + res_MAPL="" + res_MAPL(1:nstr1+nstr2+1)=trim(nx_str)//"x"//trim(ny_str) + + read(nx_str,*)nx_MAPL + read(ny_str,*)ny_MAPL + + fileT_ocn = "til/"//trim(file_ocn)//".til" ! input + fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input + fileT_ocn_lnd = "til/"//trim(file_ocn_lnd)//".til" ! input + fileR_ocn_lnd = "rst/"//trim(file_ocn_lnd)//".rst" ! input + + !print *, "Reading rst file "//trim(fileR_ocn) + open(20,file=fileR_ocn,form="unformatted",status="old") + allocate(rst_ocn(nx,ny),stat=status) + if(status/=0) then + print *, "Out of Memory" + stop endif - enddo - do i=px+1,100 - if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& - .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then - plats=i - exit - endif - enddo - do i=plats+1,100 - if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& - .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then - plate=i-1 - exit - endif - enddo - ny_str(1:plate-plats+1)=file(plats:plate) - !print *,trim(ny_str) - nstr1=plate-plats+1 - - plone=px-1 - do i=plone,1,-1 - if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& - .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then - plonss=i+1 - exit - endif - enddo - do i=plonss,plone - if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& - .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then - plons=i - exit - endif - enddo - nx_str(1:plone-plons+1)=file(plons:plone) - !print *,trim(nx_str) - nstr2=plone-plons+1 - - - do i=1,100 - if(file(i:i).eq."_")then - pocns=i+1 - exit - endif - enddo - - do i=1,100 - if(file(i:i+10).eq."Pfafstetter")then - pocne=i-2 - exit + do j=1,ny + read(20) rst_ocn(:,j) + enddo + close(20) + + !print *, "Reading rst file "//trim(fileR_ocn_lnd) + open(21,file=fileR_ocn_lnd,form="unformatted",status="old") + allocate(rst_ocn_lnd(nx,ny),stat=status) + if(status/=0) then + print *, "Out of Memory" + stop endif - enddo + do j=1,ny + read(21) rst_ocn_lnd(:,j) + enddo + close(21) + + open(10,file=fileT_ocn, form="formatted", status="old") + read(10,*) nt_ocn + allocate(t2lati(nt_ocn),t2loni(nt_ocn)) + do i=1,4 + read(10,*) + enddo + do l=1,nt_ocn + read(10,*)type,num1,num2,num3,t2loni(l),t2lati(l) + enddo + close(10) + + open(10,file=fileT_ocn_lnd, form="formatted", status="old") + read(10,*) np + do i=1,4 + read(10,*) + enddo + k=0 + do l=1,np + read(10,*)type,num1,num2,num3,num4 + if(type/=100)exit + k=k+1 + enddo + close(10) + nt_ocn_lnd=np + nl_ocn_lnd=k + + allocate(lon30s(nx),lat30s(ny)) + dx=360.d0/nx + dy=180.d0/ny + do i=1,nx + lon30s(i)=-180.d0+dx/2.d0+dx*(i-1) + enddo + do j=1,ny + lat30s(j)=-90.d0+dy/2.d0+dy*(j-1) + enddo + + !print *,"running outlets_num() ..." + call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) + !print *,"outlets num is ",ns + allocate(loni_lnd(ns),lati_lnd(ns)) + allocate(lons_adj(ns),lats_adj(ns)) + allocate(loni_ocn(ns),lati_ocn(ns)) + allocate(ns_map(nx,ny)) + allocate(lon_lnd(ns),lat_lnd(ns)) + !print *,"running retrieve_outlets() ..." + call retrieve_outlets(lons,lats,lon30s,lat30s,loni_lnd,lati_lnd,lon_lnd,lat_lnd,ns_map,nx,ny,ns) + !print *,"running mask_MAPL_1d() ..." + allocate(msk1d(nt_ocn)) + call mask_MAPL_1d(msk1d,t2loni,t2lati,nt_ocn,res_MAPL,nx_MAPL,ny_MAPL) + !print *,"running mask_MAPL_2d() ..." + allocate(msk2d(nx,ny)) + call mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt_ocn,nx,ny) + deallocate(rst_ocn,msk1d) + !print *,"running mask_MAPL_bcs() ..." + allocate(mask(nx,ny)) + call mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nx,ny,nl_ocn_lnd,nt_ocn_lnd) + deallocate(msk2d,rst_ocn_lnd) + !print *,"running ocean_boundary() ..." + allocate(boundary(nx,ny)) + call ocean_boundary(mask,boundary,nx,ny) + !print *,"running ocean_boundary_num() ..." + call ocean_boundary_num(boundary,nx,ny,nsh) + !print *,"ocean boundary point num is ",nsh + allocate(lonsh(nsh),latsh(nsh)) + !print *,"running ocean_boundary_points() ..." + call ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nx,ny,nsh) + deallocate(boundary) + !print *,"running move_to_ocean() ..." + call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) + deallocate(mask,lonsh,latsh) + !print *,"running sinkxy_ocean() ..." + call sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni_ocn,lati_ocn,ns,nx,ny) + !print *,"running update_outlets() ..." + call update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) + + deallocate(loni_lnd,lati_lnd,lons_adj,lats_adj,loni_ocn,lati_ocn) + deallocate(lon30s,lat30s) + deallocate(ns_map,lon_lnd,lat_lnd) + + end subroutine outlets_to_ocean - file_ocn="" - file_ocn(1:pocne-pocns+1)=file(pocns:pocne) - !print *,trim(file_ocn) - file_ocn_lnd="" - file_ocn_lnd(1:pocne-pocns+1)=file_ocn(1:pocne-pocns+1) - file_ocn_lnd(pocne-pocns+2:pocne-pocns+13)="-Pfafstetter" - !print *,trim(file_ocn_lnd) - - res_MAPL="" - res_MAPL(1:nstr1+nstr2+1)=trim(nx_str)//"x"//trim(ny_str) - !print *,trim(res_MAPL) - read(nx_str,*)nx_MAPL - read(ny_str,*)ny_MAPL - !print *,nx_MAPL - !print *,ny_MAPL - - fileT_ocn = "til/"//trim(file_ocn)//".til" ! input - fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input - fileT_ocn_lnd = "til/"//trim(file_ocn_lnd)//".til" ! input - fileR_ocn_lnd = "rst/"//trim(file_ocn_lnd)//".rst" ! input - - !print *, "Reading rst file "//trim(fileR_ocn) - open(20,file=fileR_ocn,form="unformatted",status="old") - allocate(rst_ocn(nx,ny),stat=status) - if(status/=0) then - print *, "Out of Memory" - stop - endif - do j=1,ny - read(20) rst_ocn(:,j) - enddo - close(20) - - !print *, "Reading rst file "//trim(fileR_ocn_lnd) - open(21,file=fileR_ocn_lnd,form="unformatted",status="old") - allocate(rst_ocn_lnd(nx,ny),stat=status) - if(status/=0) then - print *, "Out of Memory" - stop - endif - do j=1,ny - read(21) rst_ocn_lnd(:,j) - enddo - close(21) - - open(10,file=fileT_ocn, form="formatted", status="old") - read(10,*) nt_ocn - allocate(t2lati(nt_ocn),t2loni(nt_ocn)) - do i=1,4 - read(10,*) - enddo - do l=1,nt_ocn - read(10,*)type,num1,num2,num3,t2loni(l),t2lati(l) - enddo - close(10) - - open(10,file=fileT_ocn_lnd, form="formatted", status="old") - read(10,*) np - do i=1,4 - read(10,*) - enddo - k=0 - do l=1,np - read(10,*)type,num1,num2,num3,num4 - if(type/=100)exit - k=k+1 - enddo - close(10) - nt_ocn_lnd=np - nl_ocn_lnd=k - - - allocate(lon30s(nx),lat30s(ny)) - dx=360.d0/nx - dy=180.d0/ny - do i=1,nx - lon30s(i)=-180.d0+dx/2.d0+dx*(i-1) - enddo - do j=1,ny - lat30s(j)=-90.d0+dy/2.d0+dy*(j-1) - enddo - - !print *,"running outlets_num() ..." - call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) - !print *,"outlets num is ",ns - allocate(loni_lnd(ns),lati_lnd(ns)) - allocate(lons_adj(ns),lats_adj(ns)) - allocate(loni_ocn(ns),lati_ocn(ns)) - allocate(ns_map(nx,ny)) - allocate(lon_lnd(ns),lat_lnd(ns)) - !print *,"running retrieve_outlets() ..." - call retrieve_outlets(lons,lats,lon30s,lat30s,loni_lnd,lati_lnd,lon_lnd,lat_lnd,ns_map,nx,ny,ns) - !print *,"running mask_MAPL_1d() ..." - allocate(msk1d(nt_ocn)) - call mask_MAPL_1d(msk1d,t2loni,t2lati,nt_ocn,res_MAPL,nx_MAPL,ny_MAPL) - !print *,"running mask_MAPL_2d() ..." - allocate(msk2d(nx,ny)) - call mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt_ocn,nx,ny) - deallocate(rst_ocn,msk1d) - !print *,"running mask_MAPL_bcs() ..." - allocate(mask(nx,ny)) - call mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nx,ny,nl_ocn_lnd,nt_ocn_lnd) - deallocate(msk2d,rst_ocn_lnd) - !print *,"running ocean_boundary() ..." - allocate(boundary(nx,ny)) - call ocean_boundary(mask,boundary,nx,ny) - !print *,"running ocean_boundary_num() ..." - call ocean_boundary_num(boundary,nx,ny,nsh) - !print *,"ocean boundary point num is ",nsh - allocate(lonsh(nsh),latsh(nsh)) - !print *,"running ocean_boundary_points() ..." - call ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nx,ny,nsh) - deallocate(boundary) - !print *,"running move_to_ocean() ..." - call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) - deallocate(mask,lonsh,latsh) - !print *,"running sinkxy_ocean() ..." - call sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni_ocn,lati_ocn,ns,nx,ny) - !print *,"running update_outlets() ..." - call update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) - - deallocate(loni_lnd,lati_lnd,lons_adj,lats_adj,loni_ocn,lati_ocn) - deallocate(lon30s,lat30s) - deallocate(ns_map,lon_lnd,lat_lnd) - -end subroutine outlets_to_ocean !------------------------------------------------------------------------- -subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) - -integer,intent(in) :: nx,ny,nl,nt -integer,intent(inout) :: lons(nx,ny),lats(nx,ny) -integer,intent(in) :: rst_ocn_lnd(nx,ny) -integer,intent(out) :: ns - -integer,allocatable,dimension(:) :: lonp,latp -integer,allocatable,dimension(:,:) :: acc,np_map -integer :: i,j,k,l,lonc,latc,flag,maxbak,status,num - -!print *,"running outlets_num() ..." - -allocate(acc(nx,ny)) + + subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) + + integer, intent(in) :: nx,ny,nl,nt + integer, intent(inout) :: lons(nx,ny),lats(nx,ny) + integer, intent(in) :: rst_ocn_lnd(nx,ny) + integer, intent(out) :: ns + + integer, allocatable, dimension(:) :: lonp,latp + integer, allocatable, dimension(:,:) :: acc,np_map + integer :: i,j,k,l,lonc,latc,flag,maxbak,status,num + + allocate(acc(nx,ny)) + + do i=1,nx + do j=1,ny + if(rst_ocn_lnd(i,j)>nl.and.rst_ocn_lnd(i,j)/=nt)then + lons(i,j)=-999 + lats(i,j)=-999 + endif + enddo + enddo + + acc=0 + k=0 + do i=1,nx + do j=1,ny + if(lons(i,j)/=-999.and.lats(i,j)/=-999)then + lonc=lons(i,j) + latc=lats(i,j) + if(acc(lonc,latc)==0)then + k=k+1 + acc(lonc,latc)=1 + else + acc(lonc,latc)=acc(lonc,latc)+1 + endif + endif + enddo + enddo + ns=k + deallocate(acc) + + end subroutine outlets_num + + !------------------------------------------------------------------------ + + subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns_map,nx,ny,ns) + + integer, intent(in) :: nx,ny,ns + integer, intent(in) :: lons(nx,ny),lats(nx,ny) + real*8, intent(in) :: lon30s(nx),lat30s(ny) + integer, intent(out) :: lonp(ns),latp(ns) + real*8, intent(out) :: lon_lnd(ns),lat_lnd(ns) + integer, intent(out) :: ns_map(nx,ny) + + integer, allocatable,dimension(:,:) :: acc + integer :: i,j,k,l,lonc,latc + + allocate(acc(nx,ny)) + ns_map=-9999 + acc=0 + k=0 + do i=1,nx + do j=1,ny + if(lons(i,j)/=-999.and.lats(i,j)/=-999)then + lonc=lons(i,j) + latc=lats(i,j) + if(acc(lonc,latc)==0)then + k=k+1 + acc(lonc,latc)=1 + lonp(k)=lonc + latp(k)=latc + ns_map(lonc,latc)=k + else + acc(lonc,latc)=acc(lonc,latc)+1 + endif + endif + enddo + enddo + + do i=1,ns + lon_lnd(i)=lon30s(lonp(i)) + lat_lnd(i)=lat30s(latp(i)) + enddo + + deallocate(acc) + + end subroutine retrieve_outlets + + !------------------------------------------------------------------------ + + subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) + + integer, intent(in) :: nt,nlon,nlat + integer, intent(in) :: t2loni(nt),t2lati(nt) + character(len=*), intent(in) :: res_MAPL + integer, intent(out) :: msk_tile(nt) + + real, allocatable, dimension(:,:) :: msk_MAPL + integer :: i + + allocate(msk_MAPL(nlon,nlat)) + call read_oceanModel_mapl(res_MAPL,msk_MAPL,nlon,nlat) + + do i=1,nt + msk_tile(i)=int(msk_MAPL(t2loni(i),t2lati(i))) + enddo + + deallocate(msk_MAPL) + + end subroutine mask_MAPL_1d + + !------------------------------------------------------------------------ -do i=1,nx - do j=1,ny - if(rst_ocn_lnd(i,j)>nl.and.rst_ocn_lnd(i,j)/=nt)then - lons(i,j)=-999 - lats(i,j)=-999 - endif - enddo -enddo - -acc=0 -k=0 -do i=1,nx - do j=1,ny - if(lons(i,j)/=-999.and.lats(i,j)/=-999)then - lonc=lons(i,j) - latc=lats(i,j) - if(acc(lonc,latc)==0)then - k=k+1 - acc(lonc,latc)=1 - else - acc(lonc,latc)=acc(lonc,latc)+1 - endif - endif - enddo -enddo -ns=k -deallocate(acc) -end subroutine outlets_num -!------------------------------------------------------------------------ -subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns_map,nx,ny,ns) - -integer,intent(in) :: nx,ny,ns -integer,intent(in) :: lons(nx,ny),lats(nx,ny) -real*8,intent(in) :: lon30s(nx),lat30s(ny) -integer,intent(out) :: lonp(ns),latp(ns) -real*8,intent(out) :: lon_lnd(ns),lat_lnd(ns) -integer,intent(out) :: ns_map(nx,ny) - -integer,allocatable,dimension(:,:) :: acc -integer :: i,j,k,l,lonc,latc - -!print *,"running retrieve_outlets() ..." - -allocate(acc(nx,ny)) -ns_map=-9999 -acc=0 -k=0 -do i=1,nx - do j=1,ny - if(lons(i,j)/=-999.and.lats(i,j)/=-999)then - lonc=lons(i,j) - latc=lats(i,j) - if(acc(lonc,latc)==0)then - k=k+1 - acc(lonc,latc)=1 - lonp(k)=lonc - latp(k)=latc - ns_map(lonc,latc)=k - else - acc(lonc,latc)=acc(lonc,latc)+1 - endif - endif - enddo -enddo - -do i=1,ns - lon_lnd(i)=lon30s(lonp(i)) - lat_lnd(i)=lat30s(latp(i)) -enddo - -deallocate(acc) - -end subroutine retrieve_outlets -!------------------------------------------------------------------------ -subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) - -integer,intent(in) :: nt,nlon,nlat -integer,intent(in) :: t2loni(nt),t2lati(nt) -character(len=*),intent(in) :: res_MAPL -integer,intent(out) :: msk_tile(nt) - -real,allocatable,dimension(:,:) :: msk_MAPL -integer :: i - -!print *,"running mask_MAPL_1d() ..." - -allocate(msk_MAPL(nlon,nlat)) -call read_oceanModel_mapl(res_MAPL,msk_MAPL,nlon,nlat) - -do i=1,nt - msk_tile(i)=int(msk_MAPL(t2loni(i),t2lati(i))) -enddo - -deallocate(msk_MAPL) - -end subroutine mask_MAPL_1d -!------------------------------------------------------------------------ subroutine read_oceanModel_mapl(res_MAPL,wetMask,nx,ny) - implicit none - character(len=*), intent(in) :: res_MAPL - integer,intent(in) :: nx, ny - real :: wetMask(nx,ny) - - integer :: ncid, varid, ret - character(len=4) :: subname="read" - - !print *, "Reading ocean model mask from : ", mask_file - + + ! read oceand model mask from "MAPL_Tripolar.nc" + + character(len=*), intent(in) :: res_MAPL + integer, intent(in) :: nx, ny + real intent(out) :: wetMask(nx,ny) + + integer :: ncid, varid, ret + character(len=4) :: subname="read" + + ! try MOM6 first + + ret=nf90_open( trim(MAKE_BCS_INPUT_DIR) // "/ocean/MOM6/" // trim(res_MAPL) // "/MAPL_Tripolar.nc", 0, ncid ) + + ! if MOM6 did not work, try MOM5, + + if(ret /= NF_NOERR)then + call check_ret( nf90_open( trim(MAKE_BCS_INPUT_DIR) // "/ocean/MOM5/" // trim(res_MAPL) // "/MAPL_Tripolar.nc", 0, ncid ), subname) + endif + + ! read "mask" from netcdf file into "wetMask" + + call check_ret(nf90_inq_varid(ncid,"mask",varid),subname) + call check_ret(nf90_get_var(ncid,varid,wetMask),subname) + call check_ret(nf90_close(ncid),subname) + + end subroutine read_oceanModel_mapl - ret=nf90_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ocean/MOM6/"//trim(res_MAPL)//"/MAPL_Tripolar.nc",0,ncid) - if(ret /= NF_NOERR)then - call check_ret(nf90_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/ocean/MOM5/"//trim(res_MAPL)//"/MAPL_Tripolar.nc",0,ncid),subname) - endif - call check_ret(nf90_inq_varid(ncid,"mask",varid),subname) - call check_ret(nf90_get_var(ncid,varid,wetMask),subname) - call check_ret(nf90_close(ncid), subname) + !------------------------------------------------------------------------ - end subroutine read_oceanModel_mapl -!------------------------------------------------------------------------ subroutine check_ret(ret, calling) - implicit none + integer, intent(in) :: ret character(len=*) :: calling - + if (ret /= NF_NOERR) then write(6,*)'netcdf error from ',trim(calling) call endrun(nf_strerror(ret)) end if - - end subroutine check_ret -!----------------------------------------------------------------------- -subroutine endrun(msg,subname) - - implicit none - character(len=*), intent(in), optional :: msg ! string to be printed - character(len=*), intent(in), optional :: subname ! subname - - if (present (subname)) then - write(6,*) 'ERROR in subroutine :', trim(subname) - end if - - if (present (msg)) then - write(6,*)'ENDRUN:', msg - else - write(6,*) 'ENDRUN: called without a message string' - end if - - stop -end subroutine endrun -!------------------------------------------------------------------------ -subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) - -integer,intent(in) :: nt,nlon,nlat -integer,intent(in) :: landocean(nlon,nlat) -integer,intent(in) :: mask1d(nt) -integer,intent(out) :: msk2d(nlon,nlat) - -real*8,allocatable,dimension(:) :: lon,lat -integer :: i,j,xi,yi,tid - -!print *,"running mask_MAPL_2d() ..." -do i=1,nlon - do j=1,nlat - tid=landocean(i,j) - msk2d(i,j)=mask1d(tid) - enddo -enddo - -end subroutine mask_MAPL_2d -!------------------------------------------------------------------------ -subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) - -integer,intent(in) :: nlon,nlat,nl,nt -integer,intent(in) :: rst_ocn_lnd(nlon,nlat) -integer,intent(in) :: mask_mapl(nlon,nlat) -integer,intent(out) :: mask(nlon,nlat) - -!print *,"running mask_MAPL_bcs() ..." -mask=0 -where(rst_ocn_lnd>nl.and.rst_ocn_lnd/=nt.and.rst_ocn_lnd/=nt-1.and.mask_mapl==1)mask=1 - -end subroutine mask_MAPL_bcs -!------------------------------------------------------------------------ -subroutine ocean_boundary(mask,boundary,nlon,nlat) - -integer,intent(in) :: nlon,nlat -integer,intent(in) :: mask(nlon,nlat) -integer,intent(out) :: boundary(nlon,nlat) - -real*8,allocatable :: lon(:),lat(:) -integer :: xi,yi,id -integer :: xp1,xm1,yp1,ym1 - -!print *,"running ocean_boundary() ..." - -boundary=mask -boundary=-9999 - -do xi=2,nlon-1 - do yi=2,nlat-1 - id=mask(xi,yi) - if(id==1)then - boundary(xi,yi)=0 - if(mask(xi+1,yi)==1.and.& - mask(xi+1,yi-1)==1.and.& - mask(xi ,yi-1)==1.and.& - mask(xi-1,yi-1)==1.and.& - mask(xi-1,yi)==1.and.& - mask(xi-1,yi+1)==1.and.& - mask(xi ,yi+1)==1.and.& - mask(xi+1,yi+1)==1)then - boundary(xi,yi)=-9999 - endif - endif - enddo -enddo - -end subroutine ocean_boundary -!------------------------------------------------------------------------ -subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) - -integer,intent(in) :: nlon,nlat -integer,intent(in) :: mskh(nlon,nlat) -integer,intent(out) :: nsh - -integer i,xi,yi,k - -!print *,"running ocean_boundary_num() ..." -k=0 -do xi=1,nlon - do yi=1,nlat - if(mskh(xi,yi)==0)then - k=k+1 - endif - enddo -enddo -nsh=k -end subroutine ocean_boundary_num -!------------------------------------------------------------------------ -subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) - -integer,intent(in) :: nlon,nlat,nsh -integer,intent(in) :: mskh(nlon,nlat) -real*8,intent(in) :: lon30s(nlon),lat30s(nlat) -real*8,intent(out) :: lonsh(nsh),latsh(nsh) -integer i,xi,yi,k - -!print *,"running ocean_boundary_points() ..." -k=0 -do xi=1,nlon - do yi=1,nlat - if(mskh(xi,yi)==0)then - k=k+1 - lonsh(k)=lon30s(xi) - latsh(k)=lat30s(yi) - endif - enddo -enddo -end subroutine ocean_boundary_points -!------------------------------------------------------------------------ -subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) - -integer,intent(in) :: ns,nlon,nlat,nsh -integer,intent(in) :: lonsi(ns),latsi(ns) -real*8,intent(in) :: lons(ns),lats(ns) -integer,intent(in) :: mask(nlon,nlat) -real*8,intent(in) :: lonsh(nsh),latsh(nsh) -real*8,intent(out) :: lons_adj(ns),lats_adj(ns) - -!integer,allocatable :: catid(:),flag(:) - -real,allocatable :: dist(:) - -integer :: i,j -real :: dy,dy2,dx,dx2,dxA,dxB,dist_temp - -!print *,"running move_to_ocean() ..." - -allocate(dist(ns)) -do i=1,ns - IF(mask(lonsi(i),latsi(i))==0)THEN - dist(i)=1.e12 - do j=1,nsh - dy=abs(lats(i)-latsh(j)) - dy2=dy*dy - dxA=abs(lons(i)-lonsh(j)) - dxB=360.-dxA - dx=min(dxA,dxB) - dx2=dx*dx - dist_temp=sqrt(dx2+dy2) - if(dist_tempns)then - print *,"ns_map is Incorrect, ind=",ind - stop - endif - lons(i,j)=loni_ocn(ind) - lats(i,j)=lati_ocn(ind) - - endif - enddo -enddo - -end subroutine update_outlets -!------------------------------------------------------------------------ + + end subroutine check_ret + + !----------------------------------------------------------------------- + + subroutine endrun(msg,subname) + + character(len=*), intent(in), optional :: msg ! string to be printed + character(len=*), intent(in), optional :: subname ! subname + + if (present(subname)) then + write(6,*) 'ERROR in subroutine :', trim(subname) + end if + + if (present(msg)) then + write(6,*)'ENDRUN: ', msg + else + write(6,*) 'ENDRUN: called without a message string' + end if + + stop + + end subroutine endrun + + !------------------------------------------------------------------------ + + subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) + + integer, intent(in) :: nt,nlon,nlat + integer, intent(in) :: landocean(nlon,nlat) + integer, intent(in) :: mask1d(nt) + integer, intent(out) :: msk2d(nlon,nlat) + + real*8, allocatable,dimension(:) :: lon,lat + integer :: i,j,xi,yi,tid + + do i=1,nlon + do j=1,nlat + tid=landocean(i,j) + msk2d(i,j)=mask1d(tid) + enddo + enddo + + end subroutine mask_MAPL_2d + + !------------------------------------------------------------------------ + + subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) + + integer,intent(in) :: nlon,nlat,nl,nt + integer,intent(in) :: rst_ocn_lnd(nlon,nlat) + integer,intent(in) :: mask_mapl(nlon,nlat) + integer,intent(out) :: mask(nlon,nlat) + + mask=0 + where(rst_ocn_lnd>nl.and.rst_ocn_lnd/=nt.and.rst_ocn_lnd/=nt-1.and.mask_mapl==1)mask=1 + + end subroutine mask_MAPL_bcs + + !------------------------------------------------------------------------ + + subroutine ocean_boundary(mask,boundary,nlon,nlat) + + integer, intent(in) :: nlon,nlat + integer, intent(in) :: mask(nlon,nlat) + integer, intent(out) :: boundary(nlon,nlat) + + real*8, allocatable :: lon(:),lat(:) + integer :: xi,yi,id + integer :: xp1,xm1,yp1,ym1 + + boundary=mask + boundary=-9999 + + do xi=2,nlon-1 + do yi=2,nlat-1 + id=mask(xi,yi) + if(id==1)then + boundary(xi,yi)=0 + if(mask(xi+1,yi)==1.and.& + mask(xi+1,yi-1)==1.and.& + mask(xi ,yi-1)==1.and.& + mask(xi-1,yi-1)==1.and.& + mask(xi-1,yi)==1.and.& + mask(xi-1,yi+1)==1.and.& + mask(xi ,yi+1)==1.and.& + mask(xi+1,yi+1)==1)then + boundary(xi,yi)=-9999 + endif + endif + enddo + enddo + + end subroutine ocean_boundary + + !------------------------------------------------------------------------ + + subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) + + integer, intent(in) :: nlon,nlat + integer, intent(in) :: mskh(nlon,nlat) + integer, intent(out) :: nsh + + integer :: i,xi,yi,k + + k=0 + do xi=1,nlon + do yi=1,nlat + if(mskh(xi,yi)==0)then + k=k+1 + endif + enddo + enddo + nsh=k + + end subroutine ocean_boundary_num + + !------------------------------------------------------------------------ + + subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) + + integer,intent(in) :: nlon,nlat,nsh + integer,intent(in) :: mskh(nlon,nlat) + real*8,intent(in) :: lon30s(nlon),lat30s(nlat) + real*8,intent(out) :: lonsh(nsh),latsh(nsh) + integer i,xi,yi,k + + k=0 + do xi=1,nlon + do yi=1,nlat + if(mskh(xi,yi)==0)then + k=k+1 + lonsh(k)=lon30s(xi) + latsh(k)=lat30s(yi) + endif + enddo + enddo + end subroutine ocean_boundary_points + + !------------------------------------------------------------------------ + + subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) + + integer, intent(in) :: ns,nlon,nlat,nsh + integer, intent(in) :: lonsi(ns),latsi(ns) + real*8, intent(in) :: lons(ns),lats(ns) + integer, intent(in) :: mask(nlon,nlat) + real*8, intent(in) :: lonsh(nsh),latsh(nsh) + real*8, intent(out) :: lons_adj(ns),lats_adj(ns) + + real,allocatable :: dist(:) + + integer :: i,j + real :: dy,dy2,dx,dx2,dxA,dxB,dist_temp + + allocate(dist(ns)) + do i=1,ns + IF(mask(lonsi(i),latsi(i))==0)THEN + dist(i)=1.e12 + do j=1,nsh + dy=abs(lats(i)-latsh(j)) + dy2=dy*dy + dxA=abs(lons(i)-lonsh(j)) + dxB=360.-dxA + dx=min(dxA,dxB) + dx2=dx*dx + dist_temp=sqrt(dx2+dy2) + if(dist_tempns)then + print *,"ns_map is Incorrect, ind=",ind + stop + endif + lons(i,j)=loni_ocn(ind) + lats(i,j)=lati_ocn(ind) + + endif + enddo + enddo + + end subroutine update_outlets + + !------------------------------------------------------------------------ end program Runoff + +! ============================ EOF ===================================================== From 882f93ce3cf04800492258295b1a0bdd62b2df07 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 16 Dec 2023 10:27:05 -0500 Subject: [PATCH 26/55] fixed "executable" permissions (./Raster/preproc/routing/*[f90,txt]) --- .../Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 | 0 .../Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 | 0 .../Utils/Raster/preproc/routing/get_outlets_catchindex.f90 | 0 .../Utils/Raster/preproc/routing/get_outlets_land.f90 | 0 .../Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 | 0 .../Utils/Raster/preproc/routing/get_sinkxy_land.f90 | 0 .../GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt | 0 .../Utils/Raster/preproc/routing/routing_constant.f90 | 0 8 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt mode change 100755 => 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt old mode 100755 new mode 100644 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 old mode 100755 new mode 100644 From 048ec24e60bab73bbbaf8e6640ad63df3122b5ea Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 16 Dec 2023 10:36:45 -0500 Subject: [PATCH 27/55] minor edits (./Raster/preproc/routing/readme.txt) --- .../Utils/Raster/preproc/routing/readme.txt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt index c0607651b..d070d9fc5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -1,6 +1,6 @@ v1 11/08/2023, Yujin Zeng -The "preproc/routing" package is used for creating a file with the locations of river outlets to the ocean. +The "preproc/routing" package is used for creating a 30-arcsec raster file with the locations of river outlets to the ocean. The output from this package is a binary file "Outlet_latlon.43200x21600". @@ -8,9 +8,9 @@ The river outlets are located in land or landice tiles as defined in the raster The "Outlet_latlon.43200x21600" file is the input for "mk_runofftbl.F90" in the makebcs package, which further adjusts the outlet locations to be consistent with the ocean model resolution and domain ("mk_runofftbl.F90"). -If on NCCS/Discover, the package can be run using the script "run_routing_raster.py". Users may source g5_modules before run to get the necessary env. If not on Discover, please contact yujin.zeng@nasa.gov. +If on NCCS/Discover, the package can be run using the script "run_routing_raster.py". Users should source g5_modules before run to get the necessary env. If not on Discover, please contact yujin.zeng@nasa.gov. -The function for each f90 code are briefly described as follows: +The tasks completed by each f90 program are briefly described as follows: 1. get_outlets_catchindex.f90: Get sink catchment IDs. From d47592c14e3d1d28a14c6b2c726c590b3dde1fc0 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 16 Dec 2023 11:04:04 -0500 Subject: [PATCH 28/55] fixed indentation (./Raster/preproc/routing/*.f90) --- .../preproc/routing/Pfaf_to_2d_30s_land.f90 | 112 ++++++----- .../routing/get_landocean_Greenland_real.f90 | 144 +++++++------- .../routing/get_outlets_catchindex.f90 | 94 +++++---- .../preproc/routing/get_outlets_land.f90 | 179 +++++++++--------- .../routing/get_outlets_land_allcat.f90 | 106 +++++------ .../preproc/routing/get_sinkxy_land.f90 | 82 ++++---- .../preproc/routing/routing_constant.f90 | 45 +++-- 7 files changed, 376 insertions(+), 386 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 index e5b290ad2..c938e0bf2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 @@ -1,60 +1,58 @@ program main - -use routing_constant,only : nall,nlon,nlat -implicit none - -character(len=100) :: var1="outlet_sinky_allcat" -character(len=100) :: var2="outlet_sinkx_allcat" -character(len=100) :: map="Pfafstetter_Greenland_real" - -real*8,allocatable :: lon(:),lat(:) -integer,allocatable :: catchind(:,:) -integer,allocatable :: lons(:,:),lats(:,:) -integer,allocatable :: data_Pfaf(:) - -integer :: i,j,xi,yi,id - - -allocate(catchind(nlon,nlat),lons(nlon,nlat),lats(nlon,nlat)) -allocate(lon(nlon),lat(nlat)) - -open(30,file="outputs/"//trim(map),form="unformatted") -do j = 1,nlat - read (30) catchind(:,j) -end do - -allocate(data_Pfaf(nall)) - -open(77,file="outputs/"//trim(var1)//".txt") -read(77,*)data_Pfaf -lats=-999 -do xi=1,nlon - do yi=1,nlat - if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then - id=catchind(xi,yi) - lats(xi,yi)=data_Pfaf(id) - endif + + use routing_constant,only : nall,nlon,nlat + implicit none + + character(len=100) :: var1="outlet_sinky_allcat" + character(len=100) :: var2="outlet_sinkx_allcat" + character(len=100) :: map="Pfafstetter_Greenland_real" + + real*8,allocatable :: lon(:),lat(:) + integer,allocatable :: catchind(:,:) + integer,allocatable :: lons(:,:),lats(:,:) + integer,allocatable :: data_Pfaf(:) + + integer :: i,j,xi,yi,id + + + allocate(catchind(nlon,nlat),lons(nlon,nlat),lats(nlon,nlat)) + allocate(lon(nlon),lat(nlat)) + + open(30,file="outputs/"//trim(map),form="unformatted") + do j = 1,nlat + read (30) catchind(:,j) + end do + + allocate(data_Pfaf(nall)) + + open(77,file="outputs/"//trim(var1)//".txt") + read(77,*)data_Pfaf + lats=-999 + do xi=1,nlon + do yi=1,nlat + if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then + id=catchind(xi,yi) + lats(xi,yi)=data_Pfaf(id) + endif + enddo enddo -enddo - -open(77,file="outputs/"//trim(var2)//".txt") -read(77,*)data_Pfaf -lons=-999 -do xi=1,nlon - do yi=1,nlat - if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then - id=catchind(xi,yi) - lons(xi,yi)=data_Pfaf(id) - endif + + open(77,file="outputs/"//trim(var2)//".txt") + read(77,*)data_Pfaf + lons=-999 + do xi=1,nlon + do yi=1,nlat + if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then + id=catchind(xi,yi) + lons(xi,yi)=data_Pfaf(id) + endif + enddo enddo -enddo - -open(30,file="Outlet_latlon.43200x21600",form="unformatted") -do j = 1, nlat - write (30) lons(:,j) - write (30) lats(:,j) -end do - - - -end + + open(30,file="Outlet_latlon.43200x21600",form="unformatted") + do j = 1, nlat + write (30) lons(:,j) + write (30) lats(:,j) + end do + +end program main diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 2617d30f6..2ba80a478 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -1,74 +1,74 @@ program main - -use routing_constant, only : nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,id_glac,id_lake,id_landend - -implicit none -include 'netcdf.inc' - -real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G -integer,allocatable,dimension(:,:) :: landocean,Greenland -integer,allocatable,dimension(:) :: Pfaf_real, countc - -integer :: i,j,ret,ncid,varid - -allocate(landocean(nlon,nlat)) -allocate(lon(nlon),lat(nlat)) - -ret=nf_open("inputs/Pfafstetter.nc",0,ncid) -ret=nf_inq_varid(ncid,"lon",varid) -ret=nf_get_var_double(ncid,varid,lon) -ret=nf_close(ncid) -ret=nf_open("inputs/Pfafstetter.nc",0,ncid) -ret=nf_inq_varid(ncid,"lat",varid) -ret=nf_get_var_double(ncid,varid,lat) -ret=nf_close(ncid) -ret=nf_open("inputs/Pfafstetter.nc",0,ncid) -ret=nf_inq_varid(ncid,"data",varid) -ret=nf_get_var_int(ncid,varid,landocean) -ret=nf_close(ncid) - - -allocate(Greenland(nlon_G,nlat_G)) -allocate(lon_G(nlon_G),lat_G(nlat_G)) -ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) -ret=nf_inq_varid(ncid,"lon",varid) -ret=nf_get_var_double(ncid,varid,lon_G) -ret=nf_close(ncid) -ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) -ret=nf_inq_varid(ncid,"lat",varid) -ret=nf_get_var_double(ncid,varid,lat_G) -ret=nf_close(ncid) -ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) -ret=nf_inq_varid(ncid,"data",varid) -ret=nf_get_var_int(ncid,varid,Greenland) -ret=nf_close(ncid) - - -where(Greenland/=-9999.and.(landocean(loni_min:loni_max,lati_min:lati_max)<=id_landend.or.& - landocean(loni_min:loni_max,lati_min:lati_max)==id_glac ))& - landocean(loni_min:loni_max,lati_min:lati_max)=Greenland - - -where(landocean>id_landend.and.landocean=1)then - landocean(i,j)=Pfaf_real(landocean(i,j)) - else if(landocean(i,j)>=700000000)then - landocean(i,j)=landocean(i,j)-700000000+291284 - endif + + use routing_constant, only : nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,id_glac,id_lake,id_landend + + implicit none + include 'netcdf.inc' + + real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G + integer,allocatable,dimension(:,:) :: landocean,Greenland + integer,allocatable,dimension(:) :: Pfaf_real, countc + + integer :: i,j,ret,ncid,varid + + allocate(landocean(nlon,nlat)) + allocate(lon(nlon),lat(nlat)) + + ret=nf_open("inputs/Pfafstetter.nc",0,ncid) + ret=nf_inq_varid(ncid,"lon",varid) + ret=nf_get_var_double(ncid,varid,lon) + ret=nf_close(ncid) + ret=nf_open("inputs/Pfafstetter.nc",0,ncid) + ret=nf_inq_varid(ncid,"lat",varid) + ret=nf_get_var_double(ncid,varid,lat) + ret=nf_close(ncid) + ret=nf_open("inputs/Pfafstetter.nc",0,ncid) + ret=nf_inq_varid(ncid,"data",varid) + ret=nf_get_var_int(ncid,varid,landocean) + ret=nf_close(ncid) + + + allocate(Greenland(nlon_G,nlat_G)) + allocate(lon_G(nlon_G),lat_G(nlat_G)) + ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) + ret=nf_inq_varid(ncid,"lon",varid) + ret=nf_get_var_double(ncid,varid,lon_G) + ret=nf_close(ncid) + ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) + ret=nf_inq_varid(ncid,"lat",varid) + ret=nf_get_var_double(ncid,varid,lat_G) + ret=nf_close(ncid) + ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) + ret=nf_inq_varid(ncid,"data",varid) + ret=nf_get_var_int(ncid,varid,Greenland) + ret=nf_close(ncid) + + + where(Greenland/=-9999.and.(landocean(loni_min:loni_max,lati_min:lati_max)<=id_landend.or.& + landocean(loni_min:loni_max,lati_min:lati_max)==id_glac ))& + landocean(loni_min:loni_max,lati_min:lati_max)=Greenland + + + where(landocean>id_landend.and.landocean=1)then + landocean(i,j)=Pfaf_real(landocean(i,j)) + else if(landocean(i,j)>=700000000)then + landocean(i,j)=landocean(i,j)-700000000+291284 + endif + enddo enddo -enddo - -open(30,file="outputs/Pfafstetter_Greenland_real",form="unformatted") -do j = 1,nlat - write (30) landocean(:,j) -end do - -end + + open(30,file="outputs/Pfafstetter_Greenland_real",form="unformatted") + do j = 1,nlat + write (30) landocean(:,j) + end do + +end program main diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 index 566a85dc7..77103e96c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 @@ -1,49 +1,47 @@ program main - -use routing_constant,only : nc,ns,ng -implicit none - -integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall - -integer :: k,i,ntot - -ntot=nc+ng -allocate(msk(nc),outid(ns),mskall(ntot),final(nc),finalall(ntot)) -open(77,file="inputs/Pfaf_msk.txt") -read(77,*)msk -k=0 -do i=1,nc - if(msk(i).eq.2)then - k=k+1 - outid(k)=i - end if -end do -do i=k+1,ns - outid(i)=nc+i-k -end do -open(88,file="outputs/outlet_catchindex.txt") -do i=1,ns - write(88,*)outid(i) -enddo - -mskall(1:nc)=msk -mskall(nc+1:)=2 -open(88,file="outputs/Pfaf_msk_all.txt") -do i=1,ntot - write(88,*)mskall(i) -enddo - -open(77,file="inputs/Pfaf_finalID.txt") -read(77,*)final -finalall(1:nc)=final -do i=nc+1,ntot - finalall(i)=i -end do -open(88,file="outputs/Pfaf_finalID_all.txt") -do i=1,ntot - write(88,*)finalall(i) -enddo - - - -end + + use routing_constant,only : nc,ns,ng + implicit none + + integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall + + integer :: k,i,ntot + + ntot=nc+ng + allocate(msk(nc),outid(ns),mskall(ntot),final(nc),finalall(ntot)) + open(77,file="inputs/Pfaf_msk.txt") + read(77,*)msk + k=0 + do i=1,nc + if(msk(i).eq.2)then + k=k+1 + outid(k)=i + end if + end do + do i=k+1,ns + outid(i)=nc+i-k + end do + open(88,file="outputs/outlet_catchindex.txt") + do i=1,ns + write(88,*)outid(i) + enddo + + mskall(1:nc)=msk + mskall(nc+1:)=2 + open(88,file="outputs/Pfaf_msk_all.txt") + do i=1,ntot + write(88,*)mskall(i) + enddo + + open(77,file="inputs/Pfaf_finalID.txt") + read(77,*)final + finalall(1:nc)=final + do i=nc+1,ntot + finalall(i)=i + end do + open(88,file="outputs/Pfaf_finalID_all.txt") + do i=1,ntot + write(88,*)finalall(i) + enddo + +end program main diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index fc5d0b1ea..47f64a7d4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -1,94 +1,91 @@ program main -use routing_constant,only : nc,nl,ng,nlon=>nlon1m,nlat=>nlat1m -implicit none -include 'netcdf.inc' - -real*8,allocatable :: lon(:),lat(:),long(:),latg(:),lons(:),lats(:) -integer,allocatable :: catchind(:,:) -real,allocatable :: acah(:,:) -integer,allocatable :: down(:),sx(:),sy(:),msk(:) -real,allocatable :: acas(:) - -integer :: id,xi,yi,i,k,xis,yis,ntot,ncid,ret,varid - -ntot=nl+ng -allocate(catchind(nlon,nlat),acah(nlon,nlat)) -allocate(lon(nlon),lat(nlat)) -allocate(sx(nc),sy(nc),acas(nc),down(nc),msk(nc)) -allocate(long(ng),latg(ng),lons(ntot),lats(ntot)) - - -ret=nf_open("inputs/CatchIndex.nc",0,ncid) -ret=nf_inq_varid(ncid,"lon",varid) -ret=nf_get_var_double(ncid,varid,lon) -ret=nf_close(ncid) -ret=nf_open("inputs/CatchIndex.nc",0,ncid) -ret=nf_inq_varid(ncid,"lat",varid) -ret=nf_get_var_double(ncid,varid,lat) -ret=nf_close(ncid) - -ret=nf_open("inputs/CatchIndex.nc",0,ncid) -ret=nf_inq_varid(ncid,"data",varid) -ret=nf_get_var_int(ncid,varid,catchind) -ret=nf_close(ncid) - -ret=nf_open("inputs/HydroSHEDS_drainage_area.nc",0,ncid) -ret=nf_inq_varid(ncid,"data",varid) -ret=nf_get_var_real(ncid,varid,acah) -ret=nf_close(ncid) - -open(77,file="inputs/downstream_1D_new_noadj.txt") -read(77,*)down -open(77,file="inputs/Pfaf_msk.txt") -read(77,*)msk - -acas=-9999. -sx=0 -sy=0 -do xi=1,nlon - do yi=1,nlat - if(catchind(xi,yi)>=1)then - id=catchind(xi,yi) - if(down(id)==-1.and.acah(xi,yi)>=acas(id))then - acas(id)=acah(xi,yi) - sx(id)=xi - sy(id)=yi - endif - endif + use routing_constant,only : nc,nl,ng,nlon=>nlon1m,nlat=>nlat1m + implicit none + include 'netcdf.inc' + + real*8,allocatable :: lon(:),lat(:),long(:),latg(:),lons(:),lats(:) + integer,allocatable :: catchind(:,:) + real,allocatable :: acah(:,:) + integer,allocatable :: down(:),sx(:),sy(:),msk(:) + real,allocatable :: acas(:) + + integer :: id,xi,yi,i,k,xis,yis,ntot,ncid,ret,varid + + ntot=nl+ng + allocate(catchind(nlon,nlat),acah(nlon,nlat)) + allocate(lon(nlon),lat(nlat)) + allocate(sx(nc),sy(nc),acas(nc),down(nc),msk(nc)) + allocate(long(ng),latg(ng),lons(ntot),lats(ntot)) + + + ret=nf_open("inputs/CatchIndex.nc",0,ncid) + ret=nf_inq_varid(ncid,"lon",varid) + ret=nf_get_var_double(ncid,varid,lon) + ret=nf_close(ncid) + ret=nf_open("inputs/CatchIndex.nc",0,ncid) + ret=nf_inq_varid(ncid,"lat",varid) + ret=nf_get_var_double(ncid,varid,lat) + ret=nf_close(ncid) + + ret=nf_open("inputs/CatchIndex.nc",0,ncid) + ret=nf_inq_varid(ncid,"data",varid) + ret=nf_get_var_int(ncid,varid,catchind) + ret=nf_close(ncid) + + ret=nf_open("inputs/HydroSHEDS_drainage_area.nc",0,ncid) + ret=nf_inq_varid(ncid,"data",varid) + ret=nf_get_var_real(ncid,varid,acah) + ret=nf_close(ncid) + + open(77,file="inputs/downstream_1D_new_noadj.txt") + read(77,*)down + open(77,file="inputs/Pfaf_msk.txt") + read(77,*)msk + + acas=-9999. + sx=0 + sy=0 + do xi=1,nlon + do yi=1,nlat + if(catchind(xi,yi)>=1)then + id=catchind(xi,yi) + if(down(id)==-1.and.acah(xi,yi)>=acas(id))then + acas(id)=acah(xi,yi) + sx(id)=xi + sy(id)=yi + endif + endif + enddo enddo -enddo - -where(down/=-1)sx=-1 -where(down/=-1)sy=-1 -k=0 -do i=1,nc - if(msk(i)==2)then - k=k+1 - lons(k)=lon(sx(i)) - lats(k)=lat(sy(i)) - endif -enddo - -open(77,file="inputs/Greenland_outlets_lat.txt") -read(77,*)latg -open(77,file="inputs/Greenland_outlets_lon.txt") -read(77,*)long - -lons(k+1:ntot)=long -lats(k+1:ntot)=latg - - -open(88,file="outputs/outlet_sinklat.txt") -do i=1,ntot - write(88,*)lats(i) -enddo -open(88,file="outputs/outlet_sinklon.txt") -do i=1,ntot - write(88,*)lons(i) -enddo - - - - -end + + where(down/=-1)sx=-1 + where(down/=-1)sy=-1 + k=0 + do i=1,nc + if(msk(i)==2)then + k=k+1 + lons(k)=lon(sx(i)) + lats(k)=lat(sy(i)) + endif + enddo + + open(77,file="inputs/Greenland_outlets_lat.txt") + read(77,*)latg + open(77,file="inputs/Greenland_outlets_lon.txt") + read(77,*)long + + lons(k+1:ntot)=long + lats(k+1:ntot)=latg + + + open(88,file="outputs/outlet_sinklat.txt") + do i=1,ntot + write(88,*)lats(i) + enddo + open(88,file="outputs/outlet_sinklon.txt") + do i=1,ntot + write(88,*)lons(i) + enddo + +end program main diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 index 22f61958e..7fdef4c09 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 @@ -1,55 +1,53 @@ program main - -use routing_constant,only : nall,ns -implicit none - -integer, allocatable, dimension(:) :: id_final,id_outlet,msk -integer,allocatable,dimension(:) :: lati_outlet,loni_outlet -integer,allocatable,dimension(:) :: lati_full,loni_full - -integer :: i,j - -allocate(id_final(nall),id_outlet(ns),msk(nall),& - lati_outlet(ns),loni_outlet(ns),lati_full(nall),loni_full(nall)) - -open(77,file="outputs/Pfaf_finalID_all.txt") -read(77,*)id_final -open(77,file="outputs/outlet_catchindex.txt") -read(77,*)id_outlet -open(77,file="outputs/outlet_sinky.txt") -read(77,*)lati_outlet -open(77,file="outputs/outlet_sinkx.txt") -read(77,*)loni_outlet -open(77,file="outputs/Pfaf_msk_all.txt") -read(77,*)msk - -lati_full=-999 -loni_full=-999 - -do i=1,nall - !if(mod(i,1000)==0) print *,i - if(msk(id_final(i)).eq.2)then - do j=1,ns - if(id_outlet(j).eq.id_final(i))then - lati_full(i)=lati_outlet(j) - loni_full(i)=loni_outlet(j) - end if - enddo - else if(msk(id_final(i)).eq.3)then - lati_full(i)=-999 - loni_full(i)=-999 - endif -end do - -open(88,file="outputs/outlet_sinky_allcat.txt") -do i=1,nall - write(88,*)lati_full(i) -enddo -open(88,file="outputs/outlet_sinkx_allcat.txt") -do i=1,nall - write(88,*)loni_full(i) -enddo - - - -end + + use routing_constant,only : nall,ns + implicit none + + integer, allocatable, dimension(:) :: id_final,id_outlet,msk + integer,allocatable,dimension(:) :: lati_outlet,loni_outlet + integer,allocatable,dimension(:) :: lati_full,loni_full + + integer :: i,j + + allocate(id_final(nall),id_outlet(ns),msk(nall),& + lati_outlet(ns),loni_outlet(ns),lati_full(nall),loni_full(nall)) + + open(77,file="outputs/Pfaf_finalID_all.txt") + read(77,*)id_final + open(77,file="outputs/outlet_catchindex.txt") + read(77,*)id_outlet + open(77,file="outputs/outlet_sinky.txt") + read(77,*)lati_outlet + open(77,file="outputs/outlet_sinkx.txt") + read(77,*)loni_outlet + open(77,file="outputs/Pfaf_msk_all.txt") + read(77,*)msk + + lati_full=-999 + loni_full=-999 + + do i=1,nall + !if(mod(i,1000)==0) print *,i + if(msk(id_final(i)).eq.2)then + do j=1,ns + if(id_outlet(j).eq.id_final(i))then + lati_full(i)=lati_outlet(j) + loni_full(i)=loni_outlet(j) + end if + enddo + else if(msk(id_final(i)).eq.3)then + lati_full(i)=-999 + loni_full(i)=-999 + endif + end do + + open(88,file="outputs/outlet_sinky_allcat.txt") + do i=1,nall + write(88,*)lati_full(i) + enddo + open(88,file="outputs/outlet_sinkx_allcat.txt") + do i=1,nall + write(88,*)loni_full(i) + enddo + +end program main diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 index 94c36d188..4a2ddd9c4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -1,42 +1,42 @@ program main - -use routing_constant,only : ns,nlon,nlat -implicit none - -real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis -integer,allocatable,dimension(:) :: lati,loni - -integer :: i,temp(1) - -allocate(lats(ns),lons(ns),lati(ns),loni(ns)) -allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) -open(77,file="outputs/outlet_sinklat.txt") -read(77,*)lats -open(77,file="outputs/outlet_sinklon.txt") -read(77,*)lons -open(77,file="inputs/lat_30s.txt") -read(77,*)lat30s -open(77,file="inputs/lon_30s.txt") -read(77,*)lon30s - -do i=1,ns - lat_dis=abs(lat30s-lats(i)) - temp=minloc(lat_dis) - lati(i)=temp(1) -enddo -do i=1,ns - lon_dis=abs(lon30s-lons(i)) - temp=minloc(lon_dis) - loni(i)=temp(1) -enddo - -open(88,file="outputs/outlet_sinky.txt") -do i=1,ns - write(88,*)lati(i) -enddo -open(88,file="outputs/outlet_sinkx.txt") -do i=1,ns - write(88,*)loni(i) -enddo - -end + + use routing_constant,only : ns,nlon,nlat + implicit none + + real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis + integer,allocatable,dimension(:) :: lati,loni + + integer :: i,temp(1) + + allocate(lats(ns),lons(ns),lati(ns),loni(ns)) + allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) + open(77,file="outputs/outlet_sinklat.txt") + read(77,*)lats + open(77,file="outputs/outlet_sinklon.txt") + read(77,*)lons + open(77,file="inputs/lat_30s.txt") + read(77,*)lat30s + open(77,file="inputs/lon_30s.txt") + read(77,*)lon30s + + do i=1,ns + lat_dis=abs(lat30s-lats(i)) + temp=minloc(lat_dis) + lati(i)=temp(1) + enddo + do i=1,ns + lon_dis=abs(lon30s-lons(i)) + temp=minloc(lon_dis) + loni(i)=temp(1) + enddo + + open(88,file="outputs/outlet_sinky.txt") + do i=1,ns + write(88,*)lati(i) + enddo + open(88,file="outputs/outlet_sinkx.txt") + do i=1,ns + write(88,*)loni(i) + enddo + +end program main diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 index 87571b4f4..9ee5787a5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 @@ -1,26 +1,25 @@ module routing_constant - -implicit none -public - -integer,parameter :: nlon=43200 !number of lat of the world grid with 30 sec resolution -integer,parameter :: nlat=21600 !number of lon of the world grid with 30 sec resolution -integer,parameter :: nlon1m=21600 !number of lat of the world grid with 1m resolution -integer,parameter :: nlat1m=10800 !number of lon of the world grid with 1m resolution -integer,parameter :: nlon_G=8400 !number of lat of the Greenland grid (30 sec resolution) -integer,parameter :: nlat_G=4800 !number of lon of the Greenland grid (30 sec resolution) -integer,parameter :: loni_min=12001 !index of the lon start of the Greenland grid in the world grid (30 sec resolution) -integer,parameter :: loni_max=20400 !index of the lon end of the Greenland in the world grid (30 sec resolution) -integer,parameter :: lati_min=16801 !index of the lat start of the Greenland grid in the world grid (30 sec resolution) -integer,parameter :: lati_max=21600 !index of the lat end of the Greenland in the world grid (30 sec resolution) -integer,parameter :: id_glac=290191 !index of glacier tiles in the Pfafstetter.rst -integer,parameter :: id_lake=290190 !index of lake tiles in the Pfafstetter.rst -integer,parameter :: id_landend=290188 !index of the last land tile in the Pfafstetter.rst -integer,parameter :: nc=291284 !number of catchments in land -integer,parameter :: ns=22612 !number of outlets to ocean -integer,parameter :: ng=525 !number of catchments in Greenland -integer,parameter :: nl=22087 !number of outlets to ocean in land (not including Greenland) -integer,parameter :: nall=291809 !total number of catchments in land and Greenland - + + implicit none + public + + integer,parameter :: nlon = 43200 ! number of lat of the world grid with 30 sec resolution + integer,parameter :: nlat = 21600 ! number of lon of the world grid with 30 sec resolution + integer,parameter :: nlon1m = 21600 ! number of lat of the world grid with 1 min resolution + integer,parameter :: nlat1m = 10800 ! number of lon of the world grid with 1 min resolution + integer,parameter :: nlon_G = 8400 ! number of lat of the Greenland grid (30 sec resolution) + integer,parameter :: nlat_G = 4800 ! number of lon of the Greenland grid (30 sec resolution) + integer,parameter :: loni_min = 12001 ! index of the lon start of the Greenland grid in the world grid (30 sec resolution) + integer,parameter :: loni_max = 20400 ! index of the lon end of the Greenland in the world grid (30 sec resolution) + integer,parameter :: lati_min = 16801 ! index of the lat start of the Greenland grid in the world grid (30 sec resolution) + integer,parameter :: lati_max = 21600 ! index of the lat end of the Greenland in the world grid (30 sec resolution) + integer,parameter :: id_glac = 290191 ! index of glacier tiles in the Pfafstetter.rst + integer,parameter :: id_lake = 290190 ! index of lake tiles in the Pfafstetter.rst + integer,parameter :: id_landend = 290188 ! index of the last land tile in the Pfafstetter.rst + integer,parameter :: nc = 291284 ! number of catchments in land + integer,parameter :: ns = 22612 ! number of outlets to ocean + integer,parameter :: ng = 525 ! number of catchments in Greenland + integer,parameter :: nl = 22087 ! number of outlets to ocean in land (not including Greenland) + integer,parameter :: nall = 291809 ! total number of catchments in land and Greenland end module routing_constant From 21dcbd21fe9039c5190d92f932065930327d20ba Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 16 Dec 2023 11:36:06 -0500 Subject: [PATCH 29/55] a couple of trivial changes (run_routing_raster.py, get_outlets_land.f90) --- .../Utils/Raster/preproc/routing/get_outlets_land.f90 | 1 - .../Utils/Raster/preproc/routing/run_routing_raster.py | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index 47f64a7d4..3478ed248 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -78,7 +78,6 @@ program main lons(k+1:ntot)=long lats(k+1:ntot)=latg - open(88,file="outputs/outlet_sinklat.txt") do i=1,ntot write(88,*)lats(i) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py index 839153a6b..1a77bea09 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py @@ -5,7 +5,7 @@ import os import subprocess -input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing" +input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/" # Remove files and directories os.system("rm -rf inputs >& /dev/null") From ba2577f8a1cece32d9a7b301985c62adcff7fa92 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 16 Dec 2023 12:08:35 -0500 Subject: [PATCH 30/55] fixed typo/build error from earlier commit (mk_runofftbl.F90) --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index ad42c8103..c24692fa4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -309,7 +309,7 @@ end subroutine write_route_file subroutine outlets_to_ocean(file,lons,lats,nx,ny) integer, intent(in) :: nx,ny - character(len=*) intent(in) :: file + character(len=*), intent(in) :: file integer, intent(inout) :: lons(nx,ny),lats(nx,ny) ! ----------------------------------------------------------- @@ -641,7 +641,7 @@ subroutine read_oceanModel_mapl(res_MAPL,wetMask,nx,ny) character(len=*), intent(in) :: res_MAPL integer, intent(in) :: nx, ny - real intent(out) :: wetMask(nx,ny) + real, intent(out) :: wetMask(nx,ny) integer :: ncid, varid, ret character(len=4) :: subname="read" From 029fa1f9d15859c3c4cb6e2dd498b7d1b017cda7 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 23 Jan 2024 13:42:37 -0500 Subject: [PATCH 31/55] Add get_finalID_msk.f90 to let the program read raw input from Discover, avoiding using self-processed data --- .../Raster/preproc/routing/CMakeLists.txt | 1 + .../preproc/routing/Pfaf_to_2d_30s_land.f90 | 6 +- .../preproc/routing/get_finalID_msk.f90 | 152 ++++++++++++++++++ .../routing/get_landocean_Greenland_real.f90 | 48 +++--- .../routing/get_outlets_catchindex.f90 | 9 +- .../preproc/routing/get_outlets_land.f90 | 16 +- .../routing/get_outlets_land_allcat.f90 | 7 +- .../preproc/routing/get_sinkxy_land.f90 | 7 +- .../preproc/routing/routing_constant.f90 | 7 +- .../preproc/routing/run_routing_raster.py | 1 + 10 files changed, 204 insertions(+), 50 deletions(-) create mode 100644 GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt index e687c3a4b..46bdc0dc2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/CMakeLists.txt @@ -5,6 +5,7 @@ set(srcs ) set (exe_srcs + get_finalID_msk.f90 get_landocean_Greenland_real.f90 get_outlets_land_allcat.f90 get_sinkxy_land.f90 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 index c938e0bf2..bab1f5b2f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 @@ -1,6 +1,6 @@ program main - use routing_constant,only : nall,nlon,nlat + use routing_constant,only : nc,ng,nlon,nlat implicit none character(len=100) :: var1="outlet_sinky_allcat" @@ -12,9 +12,9 @@ program main integer,allocatable :: lons(:,:),lats(:,:) integer,allocatable :: data_Pfaf(:) - integer :: i,j,xi,yi,id - + integer :: i,j,xi,yi,id,nall + nall=nc+ng allocate(catchind(nlon,nlat),lons(nlon,nlat),lats(nlon,nlat)) allocate(lon(nlon),lat(nlat)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 new file mode 100644 index 000000000..86ea93117 --- /dev/null +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 @@ -0,0 +1,152 @@ +program main + +use routing_constant,only : nc +implicit none + +integer,allocatable,dimension(:) :: downid,finalid +real*8,allocatable,dimension(:) :: pfaf +integer,allocatable,dimension(:,:) :: pfaf_digit +integer*8,allocatable,dimension(:) :: res +integer,allocatable,dimension(:) :: pfaf_last,pfaf_msk,code,behind +integer,allocatable,dimension(:) :: first,last + +integer :: i,j,jj,k,p,down,cur,idx,num,ok,samed +integer :: fulli(12),fullj(12) +real :: val(9) + +open(77,file="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat", form="formatted", status="old") +read(77,*)num + +allocate(downid(nc),finalid(nc),pfaf(nc),pfaf_digit(nc,12),res(nc),pfaf_last(nc),pfaf_msk(nc)) +allocate(first(nc),last(nc)) + +do i=1,nc + read(77,*)idx,pfaf(i) +enddo + +res=int8(pfaf) +pfaf_digit(:,1)=res/(int8(10)**int8(11)) +do i=2,12 + res=res-int8(10)**int8(13-i)*int8(pfaf_digit(:,i-1)) + pfaf_digit(:,i)=res/(int8(10)**int8(12-i)) +enddo + +first=2 +last=2 +do i=1,nc + do j=12,1,-1 + if(pfaf_digit(i,j)/=0)then + pfaf_last(i)=j + do k=0,j-1 + if(pfaf_digit(i,j-k)/=1)then + last(i)=j-k + exit + endif + enddo + exit + endif + enddo +enddo +do i=1,nc + if(last(i)<=1) last(i)=2 +enddo + +do i=1,nc + do j=last(i),2,-1 + if(pfaf_digit(i,j)==0)then + first(i)=j + exit + endif + enddo +enddo + +do i=1,nc + + if(first(i)>last(i)-1)then + downid(i)=-1 + else + + allocate(code(1:last(i)-first(i))) + code=pfaf_digit(i,first(i):last(i)-1) + if(any(code==2).or.any(code==4).or.any(code==6).or.any(code==8))then + fulli=pfaf_digit(i,:) + do j=i-1,1,-1 + ok=1 + fullj=pfaf_digit(j,:) + samed=0 + do k=1,min(pfaf_last(i),pfaf_last(j)) + if(fulli(k)==fullj(k))then + samed=samed+1 + else + exit + endif + enddo + if(samed+1<=pfaf_last(j))then + allocate(behind(1:pfaf_last(j)-samed)) + behind=fullj(samed+1:pfaf_last(j)) + if(any(mod(behind,2)==0)) ok=0 + deallocate(behind) + else + ok=0 + endif + if(ok==1)then + downid(i)=j + exit + endif + enddo + else + downid(i)=-1 + endif + deallocate(code) + + endif + + +enddo + + +open(88,file="outputs/Pfaf_downid.txt") +do i=1,nc + write(88,*)downid(i) +enddo + +do i=1,nc + cur=i + down=downid(i) + do while(down/=-1) + cur=down + down=downid(cur) + enddo + finalid(i)=cur +enddo + +open(88,file="outputs/Pfaf_finalID.txt") +do i=1,nc + write(88,*)finalid(i) +enddo + + + +do i=1,nc + if(downid(i)/=-1)then + pfaf_msk(i)=1 + else + allocate(code(1:pfaf_last(i))) + code=pfaf_digit(i,1:pfaf_last(i)) + if(any(code==0))then + pfaf_msk(i)=3 + else + pfaf_msk(i)=2 + endif + deallocate(code) + end if +enddo + +open(88,file="outputs/Pfaf_msk.txt") +do i=1,nc + write(88,*)pfaf_msk(i) +enddo + + + +end \ No newline at end of file diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 2ba80a478..8333870b0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -1,33 +1,38 @@ program main - use routing_constant, only : nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,id_glac,id_lake,id_landend + use routing_constant, only : nc,nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max implicit none include 'netcdf.inc' - real*8,allocatable,dimension(:) :: lon,lat,lon_G,lat_G + real*8,allocatable,dimension(:) :: lon_G,lat_G integer,allocatable,dimension(:,:) :: landocean,Greenland integer,allocatable,dimension(:) :: Pfaf_real, countc - integer :: i,j,ret,ncid,varid + integer :: i,j,ret,ncid,varid,ntile,id_glac,id_lake,id_landend + real :: val(4) allocate(landocean(nlon,nlat)) - allocate(lon(nlon),lat(nlat)) - - ret=nf_open("inputs/Pfafstetter.nc",0,ncid) - ret=nf_inq_varid(ncid,"lon",varid) - ret=nf_get_var_double(ncid,varid,lon) - ret=nf_close(ncid) - ret=nf_open("inputs/Pfafstetter.nc",0,ncid) - ret=nf_inq_varid(ncid,"lat",varid) - ret=nf_get_var_double(ncid,varid,lat) - ret=nf_close(ncid) - ret=nf_open("inputs/Pfafstetter.nc",0,ncid) - ret=nf_inq_varid(ncid,"data",varid) - ret=nf_get_var_int(ncid,varid,landocean) - ret=nf_close(ncid) - - + open(77,file="/discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus-NLv5/Icarus-NLv5_EASE/SMAP_EASEv2_M09/rst/Pfafstetter.rst",form="unformatted",status="old") + do j=1,nlat + read(77) landocean(:,j) + enddo + close(77) + + open(77,file="/discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus-NLv5/Icarus-NLv5_EASE/SMAP_EASEv2_M09/til/Pfafstetter.til",form="formatted",status="old") + read(77,*) ntile + print *,ntile + id_glac=ntile + id_lake=ntile-1 + id_landend=ntile-3 + allocate(Pfaf_real(id_landend)) + do i=1,4 + read(77,*) + enddo + do i=1,id_landend + read(77,*) val(4),Pfaf_real(i) + enddo + allocate(Greenland(nlon_G,nlat_G)) allocate(lon_G(nlon_G),lat_G(nlat_G)) ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) @@ -52,16 +57,13 @@ program main where(landocean>id_landend.and.landocean=1)then landocean(i,j)=Pfaf_real(landocean(i,j)) else if(landocean(i,j)>=700000000)then - landocean(i,j)=landocean(i,j)-700000000+291284 + landocean(i,j)=landocean(i,j)-700000000+nc endif enddo enddo diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 index 77103e96c..7465ce66c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 @@ -1,15 +1,16 @@ program main - use routing_constant,only : nc,ns,ng + use routing_constant,only : nc,nl,ng implicit none integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall - integer :: k,i,ntot + integer :: k,i,ntot,ns ntot=nc+ng + ns=nl+ng allocate(msk(nc),outid(ns),mskall(ntot),final(nc),finalall(ntot)) - open(77,file="inputs/Pfaf_msk.txt") + open(77,file="outputs/Pfaf_msk.txt") !!! read(77,*)msk k=0 do i=1,nc @@ -33,7 +34,7 @@ program main write(88,*)mskall(i) enddo - open(77,file="inputs/Pfaf_finalID.txt") + open(77,file="outputs/Pfaf_finalID.txt") read(77,*)final finalall(1:nc)=final do i=nc+1,ntot diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index 3478ed248..f8b61fb8d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -19,17 +19,17 @@ program main allocate(long(ng),latg(ng),lons(ntot),lats(ntot)) - ret=nf_open("inputs/CatchIndex.nc",0,ncid) - ret=nf_inq_varid(ncid,"lon",varid) + ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_inq_varid(ncid,"longitude",varid) ret=nf_get_var_double(ncid,varid,lon) ret=nf_close(ncid) - ret=nf_open("inputs/CatchIndex.nc",0,ncid) - ret=nf_inq_varid(ncid,"lat",varid) + ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_inq_varid(ncid,"latitude",varid) ret=nf_get_var_double(ncid,varid,lat) ret=nf_close(ncid) - ret=nf_open("inputs/CatchIndex.nc",0,ncid) - ret=nf_inq_varid(ncid,"data",varid) + ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_inq_varid(ncid,"CatchIndex",varid) ret=nf_get_var_int(ncid,varid,catchind) ret=nf_close(ncid) @@ -38,9 +38,9 @@ program main ret=nf_get_var_real(ncid,varid,acah) ret=nf_close(ncid) - open(77,file="inputs/downstream_1D_new_noadj.txt") + open(77,file="outputs/Pfaf_downid.txt") read(77,*)down - open(77,file="inputs/Pfaf_msk.txt") + open(77,file="outputs/Pfaf_msk.txt") read(77,*)msk acas=-9999. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 index 7fdef4c09..ec1de9520 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 @@ -1,14 +1,16 @@ program main - use routing_constant,only : nall,ns + use routing_constant,only : nc,nl,ng implicit none integer, allocatable, dimension(:) :: id_final,id_outlet,msk integer,allocatable,dimension(:) :: lati_outlet,loni_outlet integer,allocatable,dimension(:) :: lati_full,loni_full - integer :: i,j + integer :: i,j,nall,ns + nall=nc+ng + ns=nl+ng allocate(id_final(nall),id_outlet(ns),msk(nall),& lati_outlet(ns),loni_outlet(ns),lati_full(nall),loni_full(nall)) @@ -27,7 +29,6 @@ program main loni_full=-999 do i=1,nall - !if(mod(i,1000)==0) print *,i if(msk(id_final(i)).eq.2)then do j=1,ns if(id_outlet(j).eq.id_final(i))then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 index 4a2ddd9c4..665c3fa51 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -1,13 +1,14 @@ program main - use routing_constant,only : ns,nlon,nlat + use routing_constant,only : nl,ng,nlon,nlat implicit none real*8,allocatable,dimension(:) :: lats,lons,lat30s,lon30s,lat_dis,lon_dis integer,allocatable,dimension(:) :: lati,loni - integer :: i,temp(1) - + integer :: i,temp(1),ns + + ns=nl+ng allocate(lats(ns),lons(ns),lati(ns),loni(ns)) allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) open(77,file="outputs/outlet_sinklat.txt") diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 index 9ee5787a5..3eb314591 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 @@ -13,13 +13,8 @@ module routing_constant integer,parameter :: loni_max = 20400 ! index of the lon end of the Greenland in the world grid (30 sec resolution) integer,parameter :: lati_min = 16801 ! index of the lat start of the Greenland grid in the world grid (30 sec resolution) integer,parameter :: lati_max = 21600 ! index of the lat end of the Greenland in the world grid (30 sec resolution) - integer,parameter :: id_glac = 290191 ! index of glacier tiles in the Pfafstetter.rst - integer,parameter :: id_lake = 290190 ! index of lake tiles in the Pfafstetter.rst - integer,parameter :: id_landend = 290188 ! index of the last land tile in the Pfafstetter.rst integer,parameter :: nc = 291284 ! number of catchments in land - integer,parameter :: ns = 22612 ! number of outlets to ocean integer,parameter :: ng = 525 ! number of catchments in Greenland - integer,parameter :: nl = 22087 ! number of outlets to ocean in land (not including Greenland) - integer,parameter :: nall = 291809 ! total number of catchments in land and Greenland + integer,parameter :: nl = 22116 ! number of outlets to ocean in land (not including Greenland) end module routing_constant diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py index 1a77bea09..d262983b5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py @@ -19,6 +19,7 @@ os.symlink(os.path.join(input_path, file), os.path.join("inputs", file)) out_programs = [ + "get_finalID_msk.x", "get_outlets_catchindex.x", "get_outlets_land.x", "get_sinkxy_land.x", From 290e44751627bcaa8c64281060a24990c4291fde Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 23 Jan 2024 15:10:34 -0500 Subject: [PATCH 32/55] fix a bug in get_landocean_Greenland_real.f90 --- .../Raster/preproc/routing/get_landocean_Greenland_real.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 8333870b0..599bd226a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -21,7 +21,6 @@ program main open(77,file="/discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus-NLv5/Icarus-NLv5_EASE/SMAP_EASEv2_M09/til/Pfafstetter.til",form="formatted",status="old") read(77,*) ntile - print *,ntile id_glac=ntile id_lake=ntile-1 id_landend=ntile-3 @@ -30,7 +29,7 @@ program main read(77,*) enddo do i=1,id_landend - read(77,*) val(4),Pfaf_real(i) + read(77,*) val(1:4),Pfaf_real(i) enddo allocate(Greenland(nlon_G,nlat_G)) From 44d2d3b2290592d2eef8182160f0d4f6ccf60d9a Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 23 Jan 2024 15:41:28 -0500 Subject: [PATCH 33/55] avoiding request of lat_30s.txt and lon_30s.txt from inputs --- .../Raster/preproc/routing/get_sinkxy_land.f90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 index 665c3fa51..cde4e00d4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -7,6 +7,7 @@ program main integer,allocatable,dimension(:) :: lati,loni integer :: i,temp(1),ns + real*8 :: dlat,dlon ns=nl+ng allocate(lats(ns),lons(ns),lati(ns),loni(ns)) @@ -15,10 +16,18 @@ program main read(77,*)lats open(77,file="outputs/outlet_sinklon.txt") read(77,*)lons - open(77,file="inputs/lat_30s.txt") - read(77,*)lat30s - open(77,file="inputs/lon_30s.txt") - read(77,*)lon30s + + dlat=180.D0/nlat + dlon=360.D0/nlon + lat30s(1)=-90.D0+dlat/2.D0 + lon30s(1)=-180.D0+dlon/2.D0 + do i=2,nlat + lat30s(i)=lat30s(i-1)+dlat + enddo + do i=2,nlon + lon30s(i)=lon30s(i-1)+dlon + enddo + do i=1,ns lat_dis=abs(lat30s-lats(i)) From 2bb8167cfe1d48ca14be0b2649f0f2ce2bed8200 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 23 Jan 2024 16:12:37 -0500 Subject: [PATCH 34/55] Input data description was added to readme.txt. --- .../Utils/Raster/preproc/routing/readme.txt | 30 ++++++++++++++----- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt index d070d9fc5..3756843be 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -12,21 +12,37 @@ If on NCCS/Discover, the package can be run using the script "run_routing_raster The tasks completed by each f90 program are briefly described as follows: -1. get_outlets_catchindex.f90: -Get sink catchment IDs. +1. get_finalID_msk.f90: +Get downstream catchment and final destination ID for each catchment, and determine whether it directs to ocean or inland lake. -2. get_outlets_land.f90: +2. get_outlets_catchindex.f90: +Get a list of sink catchment IDs. + +3. get_outlets_land.f90: Get sink points on land or in Greenland (from Lauren Andrews) by picking the point (i.e., 15-arcsec grid cell) within each sink catchment that has the largest drainage area per the HydroSHEDS (https://www.hydrosheds.org/) dataset. -3. get_sinkxy_land.f90: +4. get_sinkxy_land.f90: Convert outlet locations in degree lat/lon to indices on the 30 arc-sec raster grid. -4. get_outlets_land_allcat.f90: +5. get_outlets_land_allcat.f90: Assign outlet locations to all upstream catchments to create a 1d list showing the final x and y indexes for each catchment. -5. get_landocean_Greenland_real.f90: +6. get_landocean_Greenland_real.f90: Insert the Greenland index map into the catchment index map. -6. Pfaf_to_2d_30s_land.f90: +7. Pfaf_to_2d_30s_land.f90: Transform the 1d list above to the unformatted Fortran binary file "Outlet_latlon.43200x21600" that can be read directly by "mk_runofftbl.F90" of makebcs. +The input data are briefly described as follows: + +1. HydroSHEDS_drainage_area.nc: +The drainage_area dataset provided by the HydroSHEDS (https://www.hydrosheds.org/). + +2. GreenlandID_30s.nc: +The Greenland ID map provided by Lauren Andrews (Lauren.c.andrews@nasa.gov). + +3. Greenland_outlets_lat.txt: +The latitude of the routing outlet for each Greenland catchment provided by Lauren Andrews. + +4. Greenland_outlets_lon.txt: +The longitude of the routing outlet for each Greenland catchment provided by Lauren Andrews. From 671b8fdf5479896284625b0e88ce8c8bd8aae69e Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Wed, 24 Jan 2024 15:41:55 -0500 Subject: [PATCH 35/55] removing the dependence on Pfafstetter.rst --- .../routing/get_landocean_Greenland_real.f90 | 47 +++++++------------ 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 599bd226a..bbf6ea294 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -1,36 +1,33 @@ program main - use routing_constant, only : nc,nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max + use routing_constant, only : nc,nlon,nlat,nlon_G,nlat_G,loni_min,loni_max,lati_min,lati_max,& + nlon1m,nlat1m implicit none include 'netcdf.inc' real*8,allocatable,dimension(:) :: lon_G,lat_G - integer,allocatable,dimension(:,:) :: landocean,Greenland + integer,allocatable,dimension(:,:) :: catchind,landocean,Greenland integer,allocatable,dimension(:) :: Pfaf_real, countc - integer :: i,j,ret,ncid,varid,ntile,id_glac,id_lake,id_landend + integer :: i,j,ret,ncid,varid,ntile real :: val(4) + allocate(catchind(nlon1m,nlat1m)) + ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_inq_varid(ncid,"CatchIndex",varid) + ret=nf_get_var_int(ncid,varid,catchind) + ret=nf_close(ncid) allocate(landocean(nlon,nlat)) - open(77,file="/discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus-NLv5/Icarus-NLv5_EASE/SMAP_EASEv2_M09/rst/Pfafstetter.rst",form="unformatted",status="old") - do j=1,nlat - read(77) landocean(:,j) + landocean=-9999 + do i=1,nlon1m + do j=1,nlat1m + if(catchind(i,j)/=-9999)then + landocean(2*i-1:2*i,2*j-1:2*j)=catchind(i,j) + endif + enddo enddo - close(77) - open(77,file="/discover/nobackup/projects/gmao/bcs_shared/legacy_bcs/Icarus-NLv5/Icarus-NLv5_EASE/SMAP_EASEv2_M09/til/Pfafstetter.til",form="formatted",status="old") - read(77,*) ntile - id_glac=ntile - id_lake=ntile-1 - id_landend=ntile-3 - allocate(Pfaf_real(id_landend)) - do i=1,4 - read(77,*) - enddo - do i=1,id_landend - read(77,*) val(1:4),Pfaf_real(i) - enddo allocate(Greenland(nlon_G,nlat_G)) allocate(lon_G(nlon_G),lat_G(nlat_G)) @@ -48,20 +45,12 @@ program main ret=nf_close(ncid) - where(Greenland/=-9999.and.(landocean(loni_min:loni_max,lati_min:lati_max)<=id_landend.or.& - landocean(loni_min:loni_max,lati_min:lati_max)==id_glac ))& - landocean(loni_min:loni_max,lati_min:lati_max)=Greenland - - - where(landocean>id_landend.and.landocean=1)then - landocean(i,j)=Pfaf_real(landocean(i,j)) - else if(landocean(i,j)>=700000000)then + if(landocean(i,j)>=700000000)then landocean(i,j)=landocean(i,j)-700000000+nc endif enddo From 208862699e90b09668b2a5c64dd7f499a814d780 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 27 Mar 2024 13:04:18 -0400 Subject: [PATCH 36/55] minor cleanup and documentation (routing_constant.f90) --- .../preproc/routing/routing_constant.f90 | 22 ++++++++++--------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 index 3eb314591..c4fbfa3cb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/routing_constant.f90 @@ -1,18 +1,20 @@ module routing_constant + ! hardwired constants for GEOS river routing scheme + implicit none public - integer,parameter :: nlon = 43200 ! number of lat of the world grid with 30 sec resolution - integer,parameter :: nlat = 21600 ! number of lon of the world grid with 30 sec resolution - integer,parameter :: nlon1m = 21600 ! number of lat of the world grid with 1 min resolution - integer,parameter :: nlat1m = 10800 ! number of lon of the world grid with 1 min resolution - integer,parameter :: nlon_G = 8400 ! number of lat of the Greenland grid (30 sec resolution) - integer,parameter :: nlat_G = 4800 ! number of lon of the Greenland grid (30 sec resolution) - integer,parameter :: loni_min = 12001 ! index of the lon start of the Greenland grid in the world grid (30 sec resolution) - integer,parameter :: loni_max = 20400 ! index of the lon end of the Greenland in the world grid (30 sec resolution) - integer,parameter :: lati_min = 16801 ! index of the lat start of the Greenland grid in the world grid (30 sec resolution) - integer,parameter :: lati_max = 21600 ! index of the lat end of the Greenland in the world grid (30 sec resolution) + integer,parameter :: nlon = 43200 ! number of lat of world grid with 30 sec resolution + integer,parameter :: nlat = 21600 ! number of lon of world grid with 30 sec resolution + integer,parameter :: nlon1m = 21600 ! number of lat of world grid with 1 min resolution + integer,parameter :: nlat1m = 10800 ! number of lon of world grid with 1 min resolution + integer,parameter :: nlon_G = 8400 ! number of lat of Greenland grid (30 sec resolution) + integer,parameter :: nlat_G = 4800 ! number of lon of Greenland grid (30 sec resolution) + integer,parameter :: loni_min = 12001 ! ind of lon start of Greenland grid in world grid (30 sec resolution) + integer,parameter :: loni_max = 20400 ! = loni_min + nlon_G - 1, ind of lon end of Greenland grid in world grid (30 sec resolution) + integer,parameter :: lati_min = 16801 ! ind of lat start of Greenland grid in world grid (30 sec resolution) + integer,parameter :: lati_max = 21600 ! = lati_min + nlat_G - 1, ind of lat end of Greenland grid in world grid (30 sec resolution) integer,parameter :: nc = 291284 ! number of catchments in land integer,parameter :: ng = 525 ! number of catchments in Greenland integer,parameter :: nl = 22116 ! number of outlets to ocean in land (not including Greenland) From 3ae8dfd0cf8f3ece3c89804440fbd6d6c2d1a25b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 27 Mar 2024 13:19:25 -0400 Subject: [PATCH 37/55] fixed indentation (get_finalID_msk.f90) --- .../preproc/routing/get_finalID_msk.f90 | 284 +++++++++--------- 1 file changed, 142 insertions(+), 142 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 index 86ea93117..cfb8a1a5e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 @@ -1,152 +1,152 @@ program main -use routing_constant,only : nc -implicit none - -integer,allocatable,dimension(:) :: downid,finalid -real*8,allocatable,dimension(:) :: pfaf -integer,allocatable,dimension(:,:) :: pfaf_digit -integer*8,allocatable,dimension(:) :: res -integer,allocatable,dimension(:) :: pfaf_last,pfaf_msk,code,behind -integer,allocatable,dimension(:) :: first,last - -integer :: i,j,jj,k,p,down,cur,idx,num,ok,samed -integer :: fulli(12),fullj(12) -real :: val(9) - -open(77,file="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat", form="formatted", status="old") -read(77,*)num - -allocate(downid(nc),finalid(nc),pfaf(nc),pfaf_digit(nc,12),res(nc),pfaf_last(nc),pfaf_msk(nc)) -allocate(first(nc),last(nc)) - -do i=1,nc - read(77,*)idx,pfaf(i) -enddo - -res=int8(pfaf) -pfaf_digit(:,1)=res/(int8(10)**int8(11)) -do i=2,12 - res=res-int8(10)**int8(13-i)*int8(pfaf_digit(:,i-1)) - pfaf_digit(:,i)=res/(int8(10)**int8(12-i)) -enddo - -first=2 -last=2 -do i=1,nc - do j=12,1,-1 - if(pfaf_digit(i,j)/=0)then - pfaf_last(i)=j - do k=0,j-1 - if(pfaf_digit(i,j-k)/=1)then - last(i)=j-k - exit - endif - enddo - exit - endif + use routing_constant,only : nc + implicit none + + integer,allocatable,dimension(:) :: downid,finalid + real*8,allocatable,dimension(:) :: pfaf + integer,allocatable,dimension(:,:) :: pfaf_digit + integer*8,allocatable,dimension(:) :: res + integer,allocatable,dimension(:) :: pfaf_last,pfaf_msk,code,behind + integer,allocatable,dimension(:) :: first,last + + integer :: i,j,jj,k,p,down,cur,idx,num,ok,samed + integer :: fulli(12),fullj(12) + real :: val(9) + + open(77,file="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat", form="formatted", status="old") + read(77,*)num + + allocate(downid(nc),finalid(nc),pfaf(nc),pfaf_digit(nc,12),res(nc),pfaf_last(nc),pfaf_msk(nc)) + allocate(first(nc),last(nc)) + + do i=1,nc + read(77,*)idx,pfaf(i) enddo -enddo -do i=1,nc - if(last(i)<=1) last(i)=2 -enddo - -do i=1,nc - do j=last(i),2,-1 - if(pfaf_digit(i,j)==0)then - first(i)=j - exit - endif + + res=int8(pfaf) + pfaf_digit(:,1)=res/(int8(10)**int8(11)) + do i=2,12 + res=res-int8(10)**int8(13-i)*int8(pfaf_digit(:,i-1)) + pfaf_digit(:,i)=res/(int8(10)**int8(12-i)) enddo -enddo - -do i=1,nc - - if(first(i)>last(i)-1)then - downid(i)=-1 - else - - allocate(code(1:last(i)-first(i))) - code=pfaf_digit(i,first(i):last(i)-1) - if(any(code==2).or.any(code==4).or.any(code==6).or.any(code==8))then - fulli=pfaf_digit(i,:) - do j=i-1,1,-1 - ok=1 - fullj=pfaf_digit(j,:) - samed=0 - do k=1,min(pfaf_last(i),pfaf_last(j)) - if(fulli(k)==fullj(k))then - samed=samed+1 - else - exit - endif - enddo - if(samed+1<=pfaf_last(j))then - allocate(behind(1:pfaf_last(j)-samed)) - behind=fullj(samed+1:pfaf_last(j)) - if(any(mod(behind,2)==0)) ok=0 - deallocate(behind) - else - ok=0 + + first=2 + last=2 + do i=1,nc + do j=12,1,-1 + if(pfaf_digit(i,j)/=0)then + pfaf_last(i)=j + do k=0,j-1 + if(pfaf_digit(i,j-k)/=1)then + last(i)=j-k + exit + endif + enddo + exit endif - if(ok==1)then - downid(i)=j - exit + enddo + enddo + do i=1,nc + if(last(i)<=1) last(i)=2 + enddo + + do i=1,nc + do j=last(i),2,-1 + if(pfaf_digit(i,j)==0)then + first(i)=j + exit endif - enddo - else - downid(i)=-1 - endif - deallocate(code) - - endif - - -enddo - + enddo + enddo + + do i=1,nc + + if(first(i)>last(i)-1)then + downid(i)=-1 + else + + allocate(code(1:last(i)-first(i))) + code=pfaf_digit(i,first(i):last(i)-1) + if(any(code==2).or.any(code==4).or.any(code==6).or.any(code==8))then + fulli=pfaf_digit(i,:) + do j=i-1,1,-1 + ok=1 + fullj=pfaf_digit(j,:) + samed=0 + do k=1,min(pfaf_last(i),pfaf_last(j)) + if(fulli(k)==fullj(k))then + samed=samed+1 + else + exit + endif + enddo + if(samed+1<=pfaf_last(j))then + allocate(behind(1:pfaf_last(j)-samed)) + behind=fullj(samed+1:pfaf_last(j)) + if(any(mod(behind,2)==0)) ok=0 + deallocate(behind) + else + ok=0 + endif + if(ok==1)then + downid(i)=j + exit + endif + enddo + else + downid(i)=-1 + endif + deallocate(code) + + endif + + + enddo -open(88,file="outputs/Pfaf_downid.txt") -do i=1,nc - write(88,*)downid(i) -enddo -do i=1,nc - cur=i - down=downid(i) - do while(down/=-1) + open(88,file="outputs/Pfaf_downid.txt") + do i=1,nc + write(88,*)downid(i) + enddo + + do i=1,nc + cur=i + down=downid(i) + do while(down/=-1) cur=down - down=downid(cur) - enddo - finalid(i)=cur -enddo - -open(88,file="outputs/Pfaf_finalID.txt") -do i=1,nc - write(88,*)finalid(i) -enddo - - - -do i=1,nc - if(downid(i)/=-1)then - pfaf_msk(i)=1 - else + down=downid(cur) + enddo + finalid(i)=cur + enddo + + open(88,file="outputs/Pfaf_finalID.txt") + do i=1,nc + write(88,*)finalid(i) + enddo + + + + do i=1,nc + if(downid(i)/=-1)then + pfaf_msk(i)=1 + else allocate(code(1:pfaf_last(i))) - code=pfaf_digit(i,1:pfaf_last(i)) - if(any(code==0))then - pfaf_msk(i)=3 - else - pfaf_msk(i)=2 - endif - deallocate(code) - end if -enddo - -open(88,file="outputs/Pfaf_msk.txt") -do i=1,nc - write(88,*)pfaf_msk(i) -enddo - - - -end \ No newline at end of file + code=pfaf_digit(i,1:pfaf_last(i)) + if(any(code==0))then + pfaf_msk(i)=3 + else + pfaf_msk(i)=2 + endif + deallocate(code) + end if + enddo + + open(88,file="outputs/Pfaf_msk.txt") + do i=1,nc + write(88,*)pfaf_msk(i) + enddo + + + +end program main From 3869f5199afa21bf777bba0848e7c7078ca629fd Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Thu, 11 Apr 2024 14:31:28 -0400 Subject: [PATCH 38/55] Inputs are passed into the program via a command line argument --- .../preproc/routing/get_finalID_msk.f90 | 10 +++- .../routing/get_landocean_Greenland_real.f90 | 18 ++++-- .../preproc/routing/get_outlets_land.f90 | 26 +++++++-- .../Utils/Raster/preproc/routing/readme.txt | 2 +- .../preproc/routing/run_routing_raster.py | 56 ++++++++++++------- 5 files changed, 79 insertions(+), 33 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 index cfb8a1a5e..3cbeaada7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 @@ -14,7 +14,15 @@ program main integer :: fulli(12),fullj(12) real :: val(9) - open(77,file="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat", form="formatted", status="old") + character(len=100) :: file_path !/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat + + if (command_argument_count() /= 1) then + print *, "no found" + stop + endif + call get_command_argument(1, file_path) + + open(77,file=file_path, form="formatted", status="old") read(77,*)num allocate(downid(nc),finalid(nc),pfaf(nc),pfaf_digit(nc,12),res(nc),pfaf_last(nc),pfaf_msk(nc)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index bbf6ea294..9f8655665 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -13,8 +13,18 @@ program main integer :: i,j,ret,ncid,varid,ntile real :: val(4) + character(len=100) :: file_path1 !/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc + character(len=100) :: file_path2 !/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/GreenlandID_30s.nc + + if (command_argument_count() /= 2) then + print *, "no found" + stop + endif + call get_command_argument(1, file_path1) + call get_command_argument(2, file_path2) + allocate(catchind(nlon1m,nlat1m)) - ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_open(file_path1,0,ncid) ret=nf_inq_varid(ncid,"CatchIndex",varid) ret=nf_get_var_int(ncid,varid,catchind) ret=nf_close(ncid) @@ -31,15 +41,15 @@ program main allocate(Greenland(nlon_G,nlat_G)) allocate(lon_G(nlon_G),lat_G(nlat_G)) - ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) + ret=nf_open(file_path2,0,ncid) ret=nf_inq_varid(ncid,"lon",varid) ret=nf_get_var_double(ncid,varid,lon_G) ret=nf_close(ncid) - ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) + ret=nf_open(file_path2,0,ncid) ret=nf_inq_varid(ncid,"lat",varid) ret=nf_get_var_double(ncid,varid,lat_G) ret=nf_close(ncid) - ret=nf_open("inputs/GreenlandID_30s.nc",0,ncid) + ret=nf_open(file_path2,0,ncid) ret=nf_inq_varid(ncid,"data",varid) ret=nf_get_var_int(ncid,varid,Greenland) ret=nf_close(ncid) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index f8b61fb8d..a142fc250 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -12,6 +12,20 @@ program main integer :: id,xi,yi,i,k,xis,yis,ntot,ncid,ret,varid + character(len=100) :: file_path1 !/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc + character(len=100) :: file_path2 !/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/HydroSHEDS_drainage_area.nc + character(len=100) :: file_path3 !/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lat.txt + character(len=100) :: file_path4 !/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lon.txt + + if (command_argument_count() /= 4) then + print *, "no found" + stop + endif + call get_command_argument(1, file_path1) + call get_command_argument(2, file_path2) + call get_command_argument(3, file_path3) + call get_command_argument(4, file_path4) + ntot=nl+ng allocate(catchind(nlon,nlat),acah(nlon,nlat)) allocate(lon(nlon),lat(nlat)) @@ -19,21 +33,21 @@ program main allocate(long(ng),latg(ng),lons(ntot),lats(ntot)) - ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_open(file_path1,0,ncid) ret=nf_inq_varid(ncid,"longitude",varid) ret=nf_get_var_double(ncid,varid,lon) ret=nf_close(ncid) - ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_open(file_path1,0,ncid) ret=nf_inq_varid(ncid,"latitude",varid) ret=nf_get_var_double(ncid,varid,lat) ret=nf_close(ncid) - ret=nf_open("/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc",0,ncid) + ret=nf_open(file_path1,0,ncid) ret=nf_inq_varid(ncid,"CatchIndex",varid) ret=nf_get_var_int(ncid,varid,catchind) ret=nf_close(ncid) - ret=nf_open("inputs/HydroSHEDS_drainage_area.nc",0,ncid) + ret=nf_open(file_path2,0,ncid) ret=nf_inq_varid(ncid,"data",varid) ret=nf_get_var_real(ncid,varid,acah) ret=nf_close(ncid) @@ -70,9 +84,9 @@ program main endif enddo - open(77,file="inputs/Greenland_outlets_lat.txt") + open(77,file=file_path3) read(77,*)latg - open(77,file="inputs/Greenland_outlets_lon.txt") + open(77,file=file_path4) read(77,*)long lons(k+1:ntot)=long diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt index 3756843be..48cd720c4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -4,7 +4,7 @@ The "preproc/routing" package is used for creating a 30-arcsec raster file with The output from this package is a binary file "Outlet_latlon.43200x21600". -The river outlets are located in land or landice tiles as defined in the raster file "Pfafstetter.rst" from the makebcs package. +The river outlets are located in land or landice tiles as defined in the file "SRTM_PfafData.nc". The "Outlet_latlon.43200x21600" file is the input for "mk_runofftbl.F90" in the makebcs package, which further adjusts the outlet locations to be consistent with the ocean model resolution and domain ("mk_runofftbl.F90"). diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py index d262983b5..1e7be1bf1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py @@ -5,37 +5,51 @@ import os import subprocess -input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/" +#input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/" + +file_Pfafcatch="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat" +file_SRTMPfaf="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc" +file_Drainage="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/HydroSHEDS_drainage_area.nc" +file_GrnLat="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lat.txt" +file_GrnLon="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lon.txt" +file_GrnMap="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/GreenlandID_30s.nc" + # Remove files and directories -os.system("rm -rf inputs >& /dev/null") os.system("rm -rf outputs >& /dev/null") os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") # Create directories and symbolic links -os.makedirs("inputs", exist_ok=True) os.makedirs("outputs", exist_ok=True) -for file in os.listdir(input_path): - os.symlink(os.path.join(input_path, file), os.path.join("inputs", file)) - -out_programs = [ - "get_finalID_msk.x", - "get_outlets_catchindex.x", - "get_outlets_land.x", - "get_sinkxy_land.x", - "get_outlets_land_allcat.x", - "get_landocean_Greenland_real.x", - "Pfaf_to_2d_30s_land.x", -] - -for out_program in out_programs: - print(f"running {out_program}") - subprocess.run(f"./{out_program}",shell=True) + + +programs_inputs = { + "get_finalID_msk.x":[file_Pfafcatch], + "get_outlets_catchindex.x":[], + "get_outlets_land.x":[file_SRTMPfaf,file_Drainage,file_GrnLat,file_GrnLon], + "get_sinkxy_land.x":[], + "get_outlets_land_allcat.x":[], + "get_landocean_Greenland_real.x":[file_SRTMPfaf,file_GrnMap], + "Pfaf_to_2d_30s_land.x":[] +} + + +for program, input_files in program_inputs.items(): + if input_files: + for input_file in input_files: + command = [program, input_file] + subprocess.run(command) + else: + command = [program] + subprocess.run(command) + +#for out_program in out_programs: +# print(f"running {out_program}") +# subprocess.run(f"./{out_program}",shell=True) print("Outlet_latlon.43200x21600 created!") # Clean up -print("Removing temporary input/output files ...") +print("Removing temporary output files ...") os.system("rm -rf outputs") -os.system("rm -rf inputs") From 2f9964c5259a32b50d7ec57da7caaa5a7d8f23d2 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Thu, 11 Apr 2024 16:41:57 -0400 Subject: [PATCH 39/55] fix bug in run_routing_raster.py --- .../preproc/routing/run_routing_raster.py | 50 +++++++++---------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py index 1e7be1bf1..af306521f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py @@ -5,8 +5,6 @@ import os import subprocess -#input_path = "/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/" - file_Pfafcatch="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat" file_SRTMPfaf="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc" file_Drainage="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/HydroSHEDS_drainage_area.nc" @@ -14,42 +12,44 @@ file_GrnLon="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lon.txt" file_GrnMap="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/GreenlandID_30s.nc" +name_Pfafcatch = os.path.basename(file_Pfafcatch) +name_SRTMPfaf = os.path.basename(file_SRTMPfaf) +name_Drainage = os.path.basename(file_Drainage) +name_GrnLat =os.path.basename(file_GrnLat) +name_GrnLon = os.path.basename(file_GrnLon) +name_GrnMap = os.path.basename(file_GrnMap) +files=[file_Pfafcatch,file_SRTMPfaf,file_Drainage,file_GrnLat,file_GrnLon,file_GrnMap] # Remove files and directories +os.system("rm -rf inputs >& /dev/null") os.system("rm -rf outputs >& /dev/null") os.system("rm -f Outlet_latlon.43200x21600 >& /dev/null") # Create directories and symbolic links +os.makedirs("inputs", exist_ok=True) os.makedirs("outputs", exist_ok=True) - - -programs_inputs = { - "get_finalID_msk.x":[file_Pfafcatch], - "get_outlets_catchindex.x":[], - "get_outlets_land.x":[file_SRTMPfaf,file_Drainage,file_GrnLat,file_GrnLon], - "get_sinkxy_land.x":[], - "get_outlets_land_allcat.x":[], - "get_landocean_Greenland_real.x":[file_SRTMPfaf,file_GrnMap], - "Pfaf_to_2d_30s_land.x":[] +for file in files: + file_name = os.path.basename(file) + os.symlink(file, os.path.join("inputs", file_name)) + +program_inputs = { + "./get_finalID_msk.x": [f"inputs/{name_Pfafcatch}"], + "./get_outlets_catchindex.x": [], + "./get_outlets_land.x": [f"inputs/{name_SRTMPfaf}", f"inputs/{name_Drainage}", f"inputs/{name_GrnLat}", f"inputs/{name_GrnLon}"], + "./get_sinkxy_land.x": [], + "./get_outlets_land_allcat.x": [], + "./get_landocean_Greenland_real.x": [f"inputs/{name_SRTMPfaf}", f"inputs/{name_GrnMap}"], + "./Pfaf_to_2d_30s_land.x": [] } - for program, input_files in program_inputs.items(): - if input_files: - for input_file in input_files: - command = [program, input_file] - subprocess.run(command) - else: - command = [program] - subprocess.run(command) - -#for out_program in out_programs: -# print(f"running {out_program}") -# subprocess.run(f"./{out_program}",shell=True) + print(f"running {program}") + command = [program] + input_files + subprocess.run(command) print("Outlet_latlon.43200x21600 created!") # Clean up print("Removing temporary output files ...") os.system("rm -rf outputs") - +os.system("rm -rf inputs") From dd53aa1e81722eff4fdc65868ec26745c6287161 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Thu, 18 Apr 2024 14:47:20 -0400 Subject: [PATCH 40/55] Adding comments to mk_runofftbl.F90 --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 335 +++++++++++------- 1 file changed, 206 insertions(+), 129 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index c24692fa4..dd32aa091 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -305,13 +305,16 @@ subroutine write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) end subroutine write_route_file ! ------------------------------------------------------------------------ - + ! The subroutine moves outlets of each land&Greenland gridcell (with endpoint to ocean only) + ! to the nearest ocean gridcell defiend by "file" and ocean mask if the origional outlets are not in the ocean. subroutine outlets_to_ocean(file,lons,lats,nx,ny) - integer, intent(in) :: nx,ny - character(len=*), intent(in) :: file + integer, intent(in) :: nx,ny !number of lon and lat, eg: 43200 and 21600 in 30s resolution + character(len=*), intent(in) :: file !name of the domain, eg: CF0180x6C_TM1440xTM1080-Pfafstetter integer, intent(inout) :: lons(nx,ny),lats(nx,ny) - + !lons(nx,ny): lon idx of outlets of each land&Greenland gridcell (with endpoint to ocean only) + !lats(nx,ny): lat idx of outlets of each land&Greenland gridcell (with endpoint to ocean only) + !lons(nx,ny) and lats(nx,ny) are got from input binary file, eg: Outlet_latlon.43200x21600 ! ----------------------------------------------------------- integer, allocatable, dimension(:) :: lati_lnd,loni_lnd @@ -323,23 +326,86 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) real*8, allocatable, dimension(:) :: lons_adj,lats_adj integer, allocatable, dimension(:) :: lati_ocn,loni_ocn character*100 :: file_ocn - character*100 :: fileT_ocn, fileR_ocn character*100 :: file_ocn_lnd - character*100 :: fileT_ocn_lnd, fileR_ocn_lnd - character*100 :: res_MAPL - character*100 :: nx_str,ny_str + character*100 :: res_MAPL integer, allocatable, dimension(:,:) :: rst_ocn,rst_ocn_lnd - real :: num1,num2,num3,num4 integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh - integer, allocatable, dimension(:) :: t2lati,t2loni + integer, pointer, dimension(:) :: t2lati,t2loni real*8, allocatable, dimension(:) :: lon30s,lat30s - real*8 :: dx,dy - integer :: ns,nstr1,nstr2 + integer :: ns integer, allocatable, dimension(:,:) :: ns_map real*8, allocatable, dimension(:) :: lat_lnd,lon_lnd integer :: i,j,l,k,status,type,np,flag,flag2 - integer :: px,plats,plate,plons,plone,plonss,pocns,pocne + call get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) + allocate(rst_ocn(nx,ny),rst_ocn_lnd(nx,ny)) + allocate(lon30s(nx),lat30s(ny)) + call read_rst_til_files(nx,ny,file_ocn,file_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) + !print *,"running outlets_num() ..." + call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) + !print *,"outlets num is ",ns + allocate(loni_lnd(ns),lati_lnd(ns)) + allocate(lons_adj(ns),lats_adj(ns)) + allocate(loni_ocn(ns),lati_ocn(ns)) + allocate(ns_map(nx,ny)) + allocate(lon_lnd(ns),lat_lnd(ns)) + !print *,"running retrieve_outlets() ..." + call retrieve_outlets(lons,lats,lon30s,lat30s,loni_lnd,lati_lnd,lon_lnd,lat_lnd,ns_map,nx,ny,ns) + !print *,"running mask_MAPL_1d() ..." + allocate(msk1d(nt_ocn)) + call mask_MAPL_1d(msk1d,t2loni,t2lati,nt_ocn,res_MAPL,nx_MAPL,ny_MAPL) + deallocate(t2loni,t2lati) + !print *,"running mask_MAPL_2d() ..." + allocate(msk2d(nx,ny)) + call mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt_ocn,nx,ny) + deallocate(rst_ocn,msk1d) + !print *,"running mask_MAPL_bcs() ..." + allocate(mask(nx,ny)) + call mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nx,ny,nl_ocn_lnd,nt_ocn_lnd) + deallocate(msk2d,rst_ocn_lnd) + !print *,"running ocean_boundary() ..." + allocate(boundary(nx,ny)) + call ocean_boundary(mask,boundary,nx,ny) + !print *,"running ocean_boundary_num() ..." + call ocean_boundary_num(boundary,nx,ny,nsh) + !print *,"ocean boundary point num is ",nsh + allocate(lonsh(nsh),latsh(nsh)) + !print *,"running ocean_boundary_points() ..." + call ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nx,ny,nsh) + deallocate(boundary) + !print *,"running move_to_ocean() ..." + call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) + deallocate(mask,lonsh,latsh) + !print *,"running sinkxy_ocean() ..." + call sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni_ocn,lati_ocn,ns,nx,ny) + !print *,"running update_outlets() ..." + call update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) + + deallocate(loni_lnd,lati_lnd,lons_adj,lats_adj,loni_ocn,lati_ocn) + deallocate(lon30s,lat30s) + deallocate(ns_map,lon_lnd,lat_lnd) + + end subroutine outlets_to_ocean + +!------------------------------------------------------------------------- +! This subroutine gets the name of 'file_ocn' and 'file_ocn_lnd' from the input name 'file'. +! It also gets resolution of the ocean domain. + subroutine get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) + + character(len=*), intent(in) :: file !input domain name, eg: CF0180x6C_TM1440xTM1080-Pfafstetter + character(len=*), intent(out) :: file_ocn,file_ocn_lnd,res_MAPL + !file_ocn: ocean domain name, eg: TM1440xTM1080 + !file_ocn_land: ocean-land domain name, eg: TM1440xTM1080-Pfafstetter + !res_MAPL: ocean resolution name, eg: 1440x1080 + integer, intent(out) :: nx_MAPL,ny_MAPL + !nx_MAPL: number of lon of ocean domain, eg: 1440 + !ny_MAPL: number of lat of ocean domain, eg: 1080 + + character*100 :: nx_str,ny_str + integer :: px,plats,plate,plons,plone,plonss,pocns,pocne + integer :: nstr1,nstr2 + integer :: i + nx_str="" ny_str="" px=0;plats=0;plate=0;plons=0;plone=0;plonss=0 @@ -410,6 +476,29 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) read(nx_str,*)nx_MAPL read(ny_str,*)ny_MAPL + end subroutine get_domain_name + +!------------------------------------------------------------------------- +! This subroutine reads rst and til files + subroutine read_rst_til_files(nx,ny,file_ocn,file_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) + + integer, intent(in) :: nx,ny !number of lon and lat, eg: 43200 and 21600 in 30s resolution + character(len=*), intent(in) :: file_ocn,file_ocn_lnd ! input filename, eg: TM1440xTM1080 and TM1440xTM1080-Pfafstetter + + integer, intent(out) :: rst_ocn(nx,ny),rst_ocn_lnd(nx,ny) !data from rst files + integer,pointer,intent(out), dimension(:) :: t2loni,t2lati !relationship between ocn tile idx in TM1440xTM1080.rst and lat/lon idx in MAPL_Tripolar.nc + integer, intent(out) :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn + !nt_ocn_lnd: number of total tiles in the TM1440xTM1080-Pfafstetter + !nl_ocn_lnd: number of land tiles in the TM1440xTM1080-Pfafstetter + !nt_ocn: number of total tiles in the TM1440xTM1080 + real*8, intent(out) :: lon30s(nx),lat30s(ny)!lon and lat value arrays of the 30s map + + character*100 :: fileT_ocn, fileR_ocn + character*100 :: fileT_ocn_lnd, fileR_ocn_lnd + integer :: i,j,type,np,k,l + real :: num1,num2,num3,num4 + real*8 :: dx,dy + fileT_ocn = "til/"//trim(file_ocn)//".til" ! input fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input fileT_ocn_lnd = "til/"//trim(file_ocn_lnd)//".til" ! input @@ -417,11 +506,6 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) !print *, "Reading rst file "//trim(fileR_ocn) open(20,file=fileR_ocn,form="unformatted",status="old") - allocate(rst_ocn(nx,ny),stat=status) - if(status/=0) then - print *, "Out of Memory" - stop - endif do j=1,ny read(20) rst_ocn(:,j) enddo @@ -429,11 +513,6 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) !print *, "Reading rst file "//trim(fileR_ocn_lnd) open(21,file=fileR_ocn_lnd,form="unformatted",status="old") - allocate(rst_ocn_lnd(nx,ny),stat=status) - if(status/=0) then - print *, "Out of Memory" - stop - endif do j=1,ny read(21) rst_ocn_lnd(:,j) enddo @@ -465,7 +544,6 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) nt_ocn_lnd=np nl_ocn_lnd=k - allocate(lon30s(nx),lat30s(ny)) dx=360.d0/nx dy=180.d0/ny do i=1,nx @@ -473,61 +551,22 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) enddo do j=1,ny lat30s(j)=-90.d0+dy/2.d0+dy*(j-1) - enddo - - !print *,"running outlets_num() ..." - call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) - !print *,"outlets num is ",ns - allocate(loni_lnd(ns),lati_lnd(ns)) - allocate(lons_adj(ns),lats_adj(ns)) - allocate(loni_ocn(ns),lati_ocn(ns)) - allocate(ns_map(nx,ny)) - allocate(lon_lnd(ns),lat_lnd(ns)) - !print *,"running retrieve_outlets() ..." - call retrieve_outlets(lons,lats,lon30s,lat30s,loni_lnd,lati_lnd,lon_lnd,lat_lnd,ns_map,nx,ny,ns) - !print *,"running mask_MAPL_1d() ..." - allocate(msk1d(nt_ocn)) - call mask_MAPL_1d(msk1d,t2loni,t2lati,nt_ocn,res_MAPL,nx_MAPL,ny_MAPL) - !print *,"running mask_MAPL_2d() ..." - allocate(msk2d(nx,ny)) - call mask_MAPL_2d(rst_ocn,msk1d,msk2d,nt_ocn,nx,ny) - deallocate(rst_ocn,msk1d) - !print *,"running mask_MAPL_bcs() ..." - allocate(mask(nx,ny)) - call mask_MAPL_bcs(rst_ocn_lnd,msk2d,mask,nx,ny,nl_ocn_lnd,nt_ocn_lnd) - deallocate(msk2d,rst_ocn_lnd) - !print *,"running ocean_boundary() ..." - allocate(boundary(nx,ny)) - call ocean_boundary(mask,boundary,nx,ny) - !print *,"running ocean_boundary_num() ..." - call ocean_boundary_num(boundary,nx,ny,nsh) - !print *,"ocean boundary point num is ",nsh - allocate(lonsh(nsh),latsh(nsh)) - !print *,"running ocean_boundary_points() ..." - call ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nx,ny,nsh) - deallocate(boundary) - !print *,"running move_to_ocean() ..." - call move_to_ocean(loni_lnd,lati_lnd,lon_lnd,lat_lnd,mask,lonsh,latsh,lons_adj,lats_adj,ns,nx,ny,nsh) - deallocate(mask,lonsh,latsh) - !print *,"running sinkxy_ocean() ..." - call sinkxy_ocean(lons_adj,lats_adj,lon30s,lat30s,loni_ocn,lati_ocn,ns,nx,ny) - !print *,"running update_outlets() ..." - call update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) - - deallocate(loni_lnd,lati_lnd,lons_adj,lats_adj,loni_ocn,lati_ocn) - deallocate(lon30s,lat30s) - deallocate(ns_map,lon_lnd,lat_lnd) - - end subroutine outlets_to_ocean + enddo + + end subroutine read_rst_til_files !------------------------------------------------------------------------- - + ! This subroutine counts the number of outlet points from input outlets lon/lat idx map. subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) integer, intent(in) :: nx,ny,nl,nt - integer, intent(inout) :: lons(nx,ny),lats(nx,ny) - integer, intent(in) :: rst_ocn_lnd(nx,ny) - integer, intent(out) :: ns + !nx: number of lon of 30s map, 43200 + !ny: number of lat of 30s map, 21600 + !nl: number of land tiles + !nt: number of total tiles + integer, intent(inout) :: lons(nx,ny),lats(nx,ny) !map of lon/lat idx of outlets for each cells on the 30s map + integer, intent(in) :: rst_ocn_lnd(nx,ny) !map of tile idx from ocean-land rst map, eg: from TM1440xTM1080-Pfafstetter.rst + integer, intent(out) :: ns !number of the outlets integer, allocatable, dimension(:) :: lonp,latp integer, allocatable, dimension(:,:) :: acc,np_map @@ -535,6 +574,8 @@ subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) allocate(acc(nx,ny)) + !It first masks out the outlets map with the ocean-land rst map... + !If a cell is not defined as land or glacier in the ocean-land rst map, we ignore it. do i=1,nx do j=1,ny if(rst_ocn_lnd(i,j)>nl.and.rst_ocn_lnd(i,j)/=nt)then @@ -544,6 +585,7 @@ subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) enddo enddo + !Counting the outlets... acc=0 k=0 do i=1,nx @@ -566,15 +608,19 @@ subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) end subroutine outlets_num !------------------------------------------------------------------------ - + ! This subroutine retrives the outlets locations from the outlets map (nx,ny) to a list (ns) + ! It also stores the outlets idx on the 30s map subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns_map,nx,ny,ns) integer, intent(in) :: nx,ny,ns - integer, intent(in) :: lons(nx,ny),lats(nx,ny) - real*8, intent(in) :: lon30s(nx),lat30s(ny) - integer, intent(out) :: lonp(ns),latp(ns) - real*8, intent(out) :: lon_lnd(ns),lat_lnd(ns) - integer, intent(out) :: ns_map(nx,ny) + !nx: number of lon of 30s map, 43200 + !ny: number of lat of 30s map, 21600 + !ns: number of the outlets + integer, intent(in) :: lons(nx,ny),lats(nx,ny) !input map of outlets idx + real*8, intent(in) :: lon30s(nx),lat30s(ny) !lon and lat value arrays of the 30s map + integer, intent(out) :: lonp(ns),latp(ns) !list of lon and lat idx for the ns outlets + real*8, intent(out) :: lon_lnd(ns),lat_lnd(ns) !list of lon and lat value for the ns outlets + integer, intent(out) :: ns_map(nx,ny) !It stores the outlets idx on the 30s map integer, allocatable,dimension(:,:) :: acc integer :: i,j,k,l,lonc,latc @@ -611,14 +657,17 @@ subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns end subroutine retrieve_outlets !------------------------------------------------------------------------ - + ! convert the ocean mask in MAPL_Tripolar.nc to 1d list for each ocean tile defined by ocn rst, eg: TM1440xTM1080.rst subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) integer, intent(in) :: nt,nlon,nlat - integer, intent(in) :: t2loni(nt),t2lati(nt) - character(len=*), intent(in) :: res_MAPL - integer, intent(out) :: msk_tile(nt) - + !nt: number of ocean tiles + !nlon: number of lon in MAPL_Tripolar.nc, eg 1440 + !nlat: number of lat in MAPL_Tripolar.nc, eg 1080 + integer, intent(in) :: t2loni(nt),t2lati(nt) !relationship between ocn tile idx in TM1440xTM1080.rst and lat/lon idx in MAPL_Tripolar.nc + character(len=*), intent(in) :: res_MAPL !name of the ocean resolution, eg 1440x1080 + integer, intent(out) :: msk_tile(nt) !1d list for the ocean msk for each ocean tile + real, allocatable, dimension(:,:) :: msk_MAPL integer :: i @@ -634,14 +683,13 @@ subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) end subroutine mask_MAPL_1d !------------------------------------------------------------------------ - + ! read ocean mask from "MAPL_Tripolar.nc" subroutine read_oceanModel_mapl(res_MAPL,wetMask,nx,ny) - ! read oceand model mask from "MAPL_Tripolar.nc" - character(len=*), intent(in) :: res_MAPL - integer, intent(in) :: nx, ny - real, intent(out) :: wetMask(nx,ny) + character(len=*), intent(in) :: res_MAPL !ocn resolution name + integer, intent(in) :: nx, ny !ocn resolution numbers + real, intent(out) :: wetMask(nx,ny) !ocn mask from MAPL_Tripolar.nc integer :: ncid, varid, ret character(len=4) :: subname="read" @@ -700,20 +748,23 @@ subroutine endrun(msg,subname) end subroutine endrun !------------------------------------------------------------------------ - - subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) + ! convert 1d list of ocn mask to a 30s map + subroutine mask_MAPL_2d(ocean,mask1d,msk2d,nt,nlon,nlat) integer, intent(in) :: nt,nlon,nlat - integer, intent(in) :: landocean(nlon,nlat) - integer, intent(in) :: mask1d(nt) - integer, intent(out) :: msk2d(nlon,nlat) + !nt: number of ocean tiles + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + integer, intent(in) :: ocean(nlon,nlat) !tile idx from ocn rst file, eg: from TM1440xTM1080.rst + integer, intent(in) :: mask1d(nt) !1d list of ocn mask got from subroutine mask_MAPL_1d + integer, intent(out) :: msk2d(nlon,nlat) !output of the ocn mask on the 30s map real*8, allocatable,dimension(:) :: lon,lat integer :: i,j,xi,yi,tid do i=1,nlon do j=1,nlat - tid=landocean(i,j) + tid=ocean(i,j) msk2d(i,j)=mask1d(tid) enddo enddo @@ -721,27 +772,37 @@ subroutine mask_MAPL_2d(landocean,mask1d,msk2d,nt,nlon,nlat) end subroutine mask_MAPL_2d !------------------------------------------------------------------------ - + ! further mask the ocn mask from MAPL_Tripolar.nc based on the land-ocean rst eg: TM1440xTM1080-Pfafstetter.rst subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) integer,intent(in) :: nlon,nlat,nl,nt - integer,intent(in) :: rst_ocn_lnd(nlon,nlat) - integer,intent(in) :: mask_mapl(nlon,nlat) - integer,intent(out) :: mask(nlon,nlat) + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + !nl: number of lnd tile + !nt: number of total tile + integer,intent(in) :: rst_ocn_lnd(nlon,nlat) !tile idx from land-ocean rst eg: TM1440xTM1080-Pfafstetter.rst + integer,intent(in) :: mask_mapl(nlon,nlat) !ocn mask map from subroutine mask_MAPL_2d + integer,intent(out) :: mask(nlon,nlat) !ocn mask map masked further by land-ocean rst mask=0 + !tile idx<=nl are land tiles + !tile idx==nt are glacier tiles + !tile idx==nt-1 are lake tiles + !rest are all ocean tiles where(rst_ocn_lnd>nl.and.rst_ocn_lnd/=nt.and.rst_ocn_lnd/=nt-1.and.mask_mapl==1)mask=1 end subroutine mask_MAPL_bcs !------------------------------------------------------------------------ - + !find the ocean boundary cells (that are next to non-ocean cell) on the 30s map based on the ocn mask from mask_MAPL_bcs subroutine ocean_boundary(mask,boundary,nlon,nlat) integer, intent(in) :: nlon,nlat - integer, intent(in) :: mask(nlon,nlat) - integer, intent(out) :: boundary(nlon,nlat) - + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + integer, intent(in) :: mask(nlon,nlat) !ocn mask from subroutine mask_MAPL_bcs + integer, intent(out) :: boundary(nlon,nlat) !map of ocean boundary cells + real*8, allocatable :: lon(:),lat(:) integer :: xi,yi,id integer :: xp1,xm1,yp1,ym1 @@ -771,19 +832,21 @@ subroutine ocean_boundary(mask,boundary,nlon,nlat) end subroutine ocean_boundary !------------------------------------------------------------------------ - - subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) + ! counting the number of ocean boundary cells + subroutine ocean_boundary_num(boundary,nlon,nlat,nsh) integer, intent(in) :: nlon,nlat - integer, intent(in) :: mskh(nlon,nlat) - integer, intent(out) :: nsh + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + integer, intent(in) :: boundary(nlon,nlat) !map of ocean boundary cells + integer, intent(out) :: nsh !number of ocean boundary cells integer :: i,xi,yi,k k=0 do xi=1,nlon do yi=1,nlat - if(mskh(xi,yi)==0)then + if(boundary(xi,yi)==0)then k=k+1 endif enddo @@ -793,19 +856,22 @@ subroutine ocean_boundary_num(mskh,nlon,nlat,nsh) end subroutine ocean_boundary_num !------------------------------------------------------------------------ - - subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) + ! list the lat and lon of ocean boundary cells + subroutine ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) integer,intent(in) :: nlon,nlat,nsh - integer,intent(in) :: mskh(nlon,nlat) - real*8,intent(in) :: lon30s(nlon),lat30s(nlat) - real*8,intent(out) :: lonsh(nsh),latsh(nsh) + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + !nsh: number of ocean boundary cells + integer,intent(in) :: boundary(nlon,nlat) !map of ocean boundary cells + real*8,intent(in) :: lon30s(nlon),lat30s(nlat) !lon and lat value arrays of the 30s map + real*8,intent(out) :: lonsh(nsh),latsh(nsh) !lists of the lat and lon values of the ocean boundary cells integer i,xi,yi,k k=0 do xi=1,nlon do yi=1,nlat - if(mskh(xi,yi)==0)then + if(boundary(xi,yi)==0)then k=k+1 lonsh(k)=lon30s(xi) latsh(k)=lat30s(yi) @@ -815,15 +881,19 @@ subroutine ocean_boundary_points(mskh,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) end subroutine ocean_boundary_points !------------------------------------------------------------------------ - + ! move the outlet locations to the nearest ocean boundary cell subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) integer, intent(in) :: ns,nlon,nlat,nsh - integer, intent(in) :: lonsi(ns),latsi(ns) - real*8, intent(in) :: lons(ns),lats(ns) - integer, intent(in) :: mask(nlon,nlat) - real*8, intent(in) :: lonsh(nsh),latsh(nsh) - real*8, intent(out) :: lons_adj(ns),lats_adj(ns) + !ns: number of the outlets + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + !nsh: number of ocean boundary cells + integer, intent(in) :: lonsi(ns),latsi(ns) !lon and lat idx of the outlets before moving + real*8, intent(in) :: lons(ns),lats(ns) !lon and lat values of the outlets before moving + integer, intent(in) :: mask(nlon,nlat) !!ocn mask from subroutine mask_MAPL_bcs + real*8, intent(in) :: lonsh(nsh),latsh(nsh) !lists of the lat and lon values of the ocean boundary cells + real*8, intent(out) :: lons_adj(ns),lats_adj(ns) !lon and lat values of the outlets after moving real,allocatable :: dist(:) @@ -859,13 +929,17 @@ subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_ad end subroutine move_to_ocean !------------------------------------------------------------------------ - + !convert the lon and lat values of the outlets to lon and lat idx on the 30s map subroutine sinkxy_ocean(lons,lats,lon30s,lat30s,loni,lati,ns,nlon,nlat) integer, intent(in) :: ns,nlon,nlat - real*8, intent(in) :: lons(ns),lats(ns) - real*8, intent(in) :: lon30s(nlon),lat30s(nlat) - integer, intent(out) :: loni(ns),lati(ns) + !ns: number of the outlets + !nlon: number of lon in 30s map, eg 43200 + !nlat: number of lat in 30s map, eg 21600 + real*8, intent(in) :: lons(ns),lats(ns) !lon and lat values of the outlets + real*8, intent(in) :: lon30s(nlon),lat30s(nlat) !lon and lat value arrays of the 30s map + integer, intent(out) :: loni(ns),lati(ns) !lon and lat idx of the outlets + real*8, allocatable, dimension(:) :: lat_dis,lon_dis integer :: i,temp(1) @@ -887,13 +961,16 @@ subroutine sinkxy_ocean(lons,lats,lon30s,lat30s,loni,lati,ns,nlon,nlat) end subroutine sinkxy_ocean !------------------------------------------------------------------------ - + ! put the list of lon and lat idx of the outlets back to the 30s map lons(nx,ny),lats(nx,ny) subroutine update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) integer,intent(in) :: nx,ny,ns - integer,intent(in) :: loni_ocn(ns),lati_ocn(ns) - integer,intent(in) :: ns_map(nx,ny) - integer,intent(inout) :: lons(nx,ny),lats(nx,ny) + !nx: number of lon in 30s map, eg 43200 + !ny: number of lat in 30s map, eg 21600 + !ns: number of the outlets + integer,intent(in) :: loni_ocn(ns),lati_ocn(ns) !lon and lat idx of the outlets + integer,intent(in) :: ns_map(nx,ny) !it stores the outlets idx on the 30s map + integer,intent(inout) :: lons(nx,ny),lats(nx,ny) !map of lon/lat idx of outlets for each land/Greenland cells integer :: i,j,lonc,latc,ind From 07856b5c485f4e08ff87bbc718fb8bc3a6ff8d4a Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 26 Apr 2024 15:38:05 -0400 Subject: [PATCH 41/55] moving input description to input directory and adding NAS path for input files. --- .../Utils/Raster/preproc/routing/readme.txt | 13 ------------- .../Raster/preproc/routing/run_routing_raster.py | 3 +++ 2 files changed, 3 insertions(+), 13 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt index 48cd720c4..c47c3b3dc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/readme.txt @@ -33,16 +33,3 @@ Insert the Greenland index map into the catchment index map. 7. Pfaf_to_2d_30s_land.f90: Transform the 1d list above to the unformatted Fortran binary file "Outlet_latlon.43200x21600" that can be read directly by "mk_runofftbl.F90" of makebcs. -The input data are briefly described as follows: - -1. HydroSHEDS_drainage_area.nc: -The drainage_area dataset provided by the HydroSHEDS (https://www.hydrosheds.org/). - -2. GreenlandID_30s.nc: -The Greenland ID map provided by Lauren Andrews (Lauren.c.andrews@nasa.gov). - -3. Greenland_outlets_lat.txt: -The latitude of the routing outlet for each Greenland catchment provided by Lauren Andrews. - -4. Greenland_outlets_lon.txt: -The longitude of the routing outlet for each Greenland catchment provided by Lauren Andrews. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py index af306521f..aa135e5cd 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py @@ -5,6 +5,9 @@ import os import subprocess +# Input files +# For NAS users, please replace the Discover base path "/discover/nobackup/projects/gmao/bcs_shared/" +# by the NAS path "/nobackup/gmao_SIteam/ModelData/bcs_shared/" file_Pfafcatch="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat" file_SRTMPfaf="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc" file_Drainage="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/HydroSHEDS_drainage_area.nc" From 7dfb381965e020c12d5eaaa3143653d14ef41406 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Mon, 20 May 2024 20:07:44 -0400 Subject: [PATCH 42/55] Adding note (suggested by Randy Koster) to the code under preproc/routing to let it be more understandable. --- .../preproc/routing/Pfaf_to_2d_30s_land.f90 | 19 ++++++++-- .../preproc/routing/get_finalID_msk.f90 | 36 +++++++++++++------ .../routing/get_landocean_Greenland_real.f90 | 2 ++ .../routing/get_outlets_catchindex.f90 | 20 ++++++++--- .../preproc/routing/get_outlets_land.f90 | 22 ++++++++++-- .../routing/get_outlets_land_allcat.f90 | 12 +++++++ .../preproc/routing/get_sinkxy_land.f90 | 14 +++++++- 7 files changed, 104 insertions(+), 21 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 index bab1f5b2f..3935fbb3d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/Pfaf_to_2d_30s_land.f90 @@ -14,20 +14,31 @@ program main integer :: i,j,xi,yi,id,nall +! Transform the 1d list to the unformatted Fortran binary file "Outlet_latlon.43200x21600" that can be read directly by "mk_runofftbl.F90" of makebcs. +! nc= number of land catchments (excluding Greenland), 291284 in our case. +! ng= number of Greenland catchments, 525 in our case +! nall =number of the total catchments (including Greenland) +! catchind = catchment index: 1-291284 for land catchments, and 291285-291809 for Greenland catchments +! data_Pfaf= lat (or lon) index (on a 30s map) of the final sink point for each catchment, +! lats= a map (with a resolution of 30s) of lat values. For each pixel, the value is the latitude of its final outlet point +! lons= a map (with a resolution of 30s) of lon values. For each pixel, the value is the longitude of its final outlet point + nall=nc+ng allocate(catchind(nlon,nlat),lons(nlon,nlat),lats(nlon,nlat)) allocate(lon(nlon),lat(nlat)) - + +! Read the raster array of catchment indices open(30,file="outputs/"//trim(map),form="unformatted") do j = 1,nlat read (30) catchind(:,j) end do allocate(data_Pfaf(nall)) - +! Read in the latitudes associated with each catchment open(77,file="outputs/"//trim(var1)//".txt") read(77,*)data_Pfaf lats=-999 +! For each raster point, find the catchment index and use that, in conjunction with data_Pfaf, to compute a raster array of latitudes do xi=1,nlon do yi=1,nlat if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then @@ -36,10 +47,12 @@ program main endif enddo enddo - + +! Read in the longitudes associated with each catchment open(77,file="outputs/"//trim(var2)//".txt") read(77,*)data_Pfaf lons=-999 + ! For each raster point, find the catchment index and use that, in conjunction with data_Pfaf, to compute a raster array of longitudes do xi=1,nlon do yi=1,nlat if(catchind(xi,yi)>=1.and.catchind(xi,yi)<=nall)then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 index 3cbeaada7..9f65bfa9b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_finalID_msk.f90 @@ -16,6 +16,16 @@ program main character(len=100) :: file_path !/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat +! Get downstream catchment and final destination ID for each catchment, and determine whether it directs to an ocean or inland lake. +! downid=Pfafstetter index of catchment just downstream +! finalid=Pfafstetter index of catchment at outlet point +! pfaf= Pfafstetter number for catchment +! pfaf_digit= The 12 digits in a Pfafstetter number, separated +! pfaf_last= The index of the last nonzero digit in a Pfafstetter number (counting from the left) +! pfaf_msk =1 for non-sink catchments, 2 for sink catchments with endpoints in ocean, =3 for sink catchments with endpoints in interior lake +! last= The index of the last digit in a Pfafstetter number after removing any 11..000 tail. +! first= The index of the last zero (but not the zero at the very end). However, if there are no zeroes until the end, first =2 (the second index, since the first index indicates the continent). + if (command_argument_count() /= 1) then print *, "no found" stop @@ -32,13 +42,15 @@ program main read(77,*)idx,pfaf(i) enddo +! Separate Pfafstetter number into individual digits res=int8(pfaf) pfaf_digit(:,1)=res/(int8(10)**int8(11)) do i=2,12 res=res-int8(10)**int8(13-i)*int8(pfaf_digit(:,i-1)) pfaf_digit(:,i)=res/(int8(10)**int8(12-i)) enddo - + +! Determine positions of last nonzero digit (pfaf_last) and the last digit that鈥檚 neither 0 nor 1 (at the end) first=2 last=2 do i=1,nc @@ -58,7 +70,8 @@ program main do i=1,nc if(last(i)<=1) last(i)=2 enddo - + +! Determine position of final zero that has some nonzero digits after it do i=1,nc do j=last(i),2,-1 if(pfaf_digit(i,j)==0)then @@ -76,20 +89,22 @@ program main allocate(code(1:last(i)-first(i))) code=pfaf_digit(i,first(i):last(i)-1) - if(any(code==2).or.any(code==4).or.any(code==6).or.any(code==8))then + if(any(code==2).or.any(code==4).or.any(code==6).or.any(code==8))then + ! If all digits (after the first) are odd, the Pfafstetter logic implies that the catchment will be on the coast. fulli=pfaf_digit(i,:) - do j=i-1,1,-1 + do j=i-1,1,-1 ! Test each catchment to see if it lies just downstream of catchment i ok=1 fullj=pfaf_digit(j,:) samed=0 - do k=1,min(pfaf_last(i),pfaf_last(j)) + do k=1,min(pfaf_last(i),pfaf_last(j)) ! Determine the index (samed) up to which the Pfaf numbers of catchment I and j match if(fulli(k)==fullj(k))then samed=samed+1 else exit endif - enddo + enddo ! end k loop if(samed+1<=pfaf_last(j))then + ! Check that none of catchment j鈥檚 indices (after samed) are even, which would imply a downstream branching off from the river on which catchment i lies. allocate(behind(1:pfaf_last(j)-samed)) behind=fullj(samed+1:pfaf_last(j)) if(any(mod(behind,2)==0)) ok=0 @@ -101,13 +116,13 @@ program main downid(i)=j exit endif - enddo + enddo ! end j loop else downid(i)=-1 endif deallocate(code) - endif + endif ! end i loop enddo @@ -117,7 +132,8 @@ program main do i=1,nc write(88,*)downid(i) enddo - + +! Keep 鈥渕oving downstream鈥 until you find the catchment with no downstream catchment: do i=1,nc cur=i down=downid(i) @@ -134,7 +150,7 @@ program main enddo - + ! Set masks: 1 = has downstream catchment; 2 = drains to ocean; 3 = drains to inland lake do i=1,nc if(downid(i)/=-1)then pfaf_msk(i)=1 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 index 9f8655665..63da40671 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_landocean_Greenland_real.f90 @@ -16,6 +16,8 @@ program main character(len=100) :: file_path1 !/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc character(len=100) :: file_path2 !/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/GreenlandID_30s.nc +! Insert the Greenland index map into the catchment index map. + if (command_argument_count() /= 2) then print *, "no found" stop diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 index 7465ce66c..d2f69a12e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_catchindex.f90 @@ -6,7 +6,15 @@ program main integer,allocatable,dimension(:) :: msk,outid,mskall,final,finalall integer :: k,i,ntot,ns - + +! Get a list of sink catchment IDs (both land and Greenland) +! nc = number of the land catchments (excluding Greenland), 291284 in our case. +! ng = number of the Greenland catchments, 525 in our case. +! nl = number of outlets to ocean in land (not including Greenland outlets) +! ns = number of the total outlets (including Greenland); note that all the Greenland catchments are sink catchments (ie, no downstream catchment). +! ntot = number of the total catchments (including Greenland) +! outid = a list of indices for sink catchments (to ocean) + ntot=nc+ng ns=nl+ng allocate(msk(nc),outid(ns),mskall(ntot),final(nc),finalall(ntot)) @@ -14,11 +22,13 @@ program main read(77,*)msk k=0 do i=1,nc - if(msk(i).eq.2)then + if(msk(i).eq.2)then ! msk=2 is for a catchment that drains directly into the ocean k=k+1 outid(k)=i end if end do + + ! Add Greenland catchments to list of outlet catchments; write outlet catchments to file do i=k+1,ns outid(i)=nc+i-k end do @@ -26,14 +36,16 @@ program main do i=1,ns write(88,*)outid(i) enddo - + +! Append msk values for Greenland to original msk array; write out mskall(1:nc)=msk mskall(nc+1:)=2 open(88,file="outputs/Pfaf_msk_all.txt") do i=1,ntot write(88,*)mskall(i) enddo - + +! Append final values for Greenland to original 鈥渇inal鈥 array; write out open(77,file="outputs/Pfaf_finalID.txt") read(77,*)final finalall(1:nc)=final diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 index a142fc250..a8db67847 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land.f90 @@ -26,6 +26,17 @@ program main call get_command_argument(3, file_path3) call get_command_argument(4, file_path4) +! Get sink points on land or in Greenland (from Lauren Andrews) by picking the point (i.e., 1 minute grid cell) within each sink catchment that has the largest drainage area per the HydroSHEDS (https://www.hydrosheds.org/) dataset. +! acah = map of drainage area with a resolution of 1m from HydroSHEDS. +! down = catchment index of the downstream catchment. +! sx = the lon index (on a 1m map) of the outlet point (>0 only for sink catchments). +! sy = the lat index (on a 1m map) of the outlet point (>0 only for sink catchments). +! msk: 1 = has downstream catchment; 2 = drains to ocean; 3 = drains to inland lake +! acas = maximum drainage area, defined (>0) only for sink catchments +! ntot = number of the total outlets (including Greenland) +! nl = number of outlets to ocean in land (not including Greenland) +! ng = number of outlets to ocean in Greenland + ntot=nl+ng allocate(catchind(nlon,nlat),acah(nlon,nlat)) allocate(lon(nlon),lat(nlat)) @@ -56,7 +67,9 @@ program main read(77,*)down open(77,file="outputs/Pfaf_msk.txt") read(77,*)msk - + +! For each long/lat location, determine if the catchment holding it is an outlet catchment to the ocean, +! and if so, determine if this point has the maximum drainage area acas=-9999. sx=0 sy=0 @@ -72,7 +85,8 @@ program main endif enddo enddo - + +! Construct arrays of longitudes and latitudes of sink points. where(down/=-1)sx=-1 where(down/=-1)sy=-1 k=0 @@ -83,7 +97,8 @@ program main lats(k)=lat(sy(i)) endif enddo - + +! Append Greenland values to the longitude and latitude arrays. open(77,file=file_path3) read(77,*)latg open(77,file=file_path4) @@ -92,6 +107,7 @@ program main lons(k+1:ntot)=long lats(k+1:ntot)=latg +! Write out arrays of sink point longitudes and latitudes open(88,file="outputs/outlet_sinklat.txt") do i=1,ntot write(88,*)lats(i) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 index ec1de9520..49b6207f7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_outlets_land_allcat.f90 @@ -8,6 +8,15 @@ program main integer,allocatable,dimension(:) :: lati_full,loni_full integer :: i,j,nall,ns + +! Assign outlet locations to all upstream catchments to create a 1d list showing the final x and y indexes for each catchment. +! id_final = index of the final sink catchment for each catchment +! id_outlet =catchment index for each outlet +! msk = 1 = has downstream catchment; 2 = drains to ocean; 3 = drains to inland lake +! lati_outlet = lat index for each outlet +! loni_outlet =lon index for each outlet +! lati_full = lat index (on a 30s map) of its final sink point for each catchment +! loni_full = lon index (on a 30s map) of its final sink point for each catchment nall=nc+ng ns=nl+ng @@ -29,7 +38,10 @@ program main loni_full=-999 do i=1,nall +! For each catchment, check to see if its final sink catchment actually drains to the ocean. if(msk(id_final(i)).eq.2)then + ! For the catchment being tested, loop over the indices of all sink catchments and find the one that matches its own sink catchment. + ! Assign lat/longs of outlet point to the catchment being tested. do j=1,ns if(id_outlet(j).eq.id_final(i))then lati_full(i)=lati_outlet(j) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 index cde4e00d4..41d830888 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/get_sinkxy_land.f90 @@ -9,6 +9,18 @@ program main integer :: i,temp(1),ns real*8 :: dlat,dlon +! Convert outlet locations in degree lat/lon to indices on the 30 arc-sec raster grid. +! lats = lat degree of the outlets +! lons = lon degree of the outlets +! lati = lat index of the outlets on the 30s map +! loni =lon index of the outlets on the 30s map +! lat30s = lat coordinate of the 30s map +! lon30s =lon coordinate of the 30s map +! lat_dis = distance of lat between the center of each 30s pixel and the outlet point. +! lon_dis = distance of lon between the center of each 30s pixel and the outlet point. +! nlat = number of latitude indices. For 30s map, nlat = 21600 +! nlon = number of longitude indices. For 30s map, nlon = 43200 + ns=nl+ng allocate(lats(ns),lons(ns),lati(ns),loni(ns)) allocate(lat30s(nlat),lon30s(nlon),lat_dis(nlat),lon_dis(nlon)) @@ -28,7 +40,7 @@ program main lon30s(i)=lon30s(i-1)+dlon enddo - +! For each sink catchment, find the 30s-latitude and 30s-longitude closest to its outlet point. do i=1,ns lat_dis=abs(lat30s-lats(i)) temp=minloc(lat_dis) From cc738ca647542301c328d6ef43238fe480a83c89 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Sat, 15 Jun 2024 20:59:54 -0400 Subject: [PATCH 43/55] re-write get_domain_name() in the mk_runofftbl.F90 --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 95 +++++-------------- 1 file changed, 24 insertions(+), 71 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index dd32aa091..af8031375 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -404,77 +404,34 @@ subroutine get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) character*100 :: nx_str,ny_str integer :: px,plats,plate,plons,plone,plonss,pocns,pocne integer :: nstr1,nstr2 - integer :: i + integer :: i,length - nx_str="" - ny_str="" - px=0;plats=0;plate=0;plons=0;plone=0;plonss=0 - do i=100,1,-1 - if(file(i:i).eq."x")then - px=i - exit - endif - enddo - do i=px+1,100 - if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& - .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then - plats=i - exit - endif - enddo - do i=plats+1,100 - if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& - .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then - plate=i-1 - exit - endif - enddo - ny_str(1:plate-plats+1)=file(plats:plate) - nstr1=plate-plats+1 - - plone=px-1 - do i=plone,1,-1 - if(file(i:i).ne."1".and.file(i:i).ne."2".and.file(i:i).ne."3".and.file(i:i).ne."4".and.file(i:i).ne."5"& - .and.file(i:i).ne."6".and.file(i:i).ne."7".and.file(i:i).ne."8".and.file(i:i).ne."9".and.file(i:i).ne."0")then - plonss=i+1 - exit - endif - enddo - do i=plonss,plone - if(file(i:i).eq."1".or.file(i:i).eq."2".or.file(i:i).eq."3".or.file(i:i).eq."4".or.file(i:i).eq."5"& - .or.file(i:i).eq."6".or.file(i:i).eq."7".or.file(i:i).eq."8".or.file(i:i).eq."9")then - plons=i - exit - endif - enddo - nx_str(1:plone-plons+1)=file(plons:plone) - nstr2=plone-plons+1 - - do i=1,100 - if(file(i:i).eq."_")then - pocns=i+1 - exit - endif - enddo - - do i=1,100 - if(file(i:i+10).eq."Pfafstetter")then - pocne=i-2 - exit - endif - enddo - file_ocn="" - file_ocn(1:pocne-pocns+1)=file(pocns:pocne) file_ocn_lnd="" - file_ocn_lnd(1:pocne-pocns+1)=file_ocn(1:pocne-pocns+1) - file_ocn_lnd(pocne-pocns+2:pocne-pocns+13)="-Pfafstetter" - res_MAPL="" - res_MAPL(1:nstr1+nstr2+1)=trim(nx_str)//"x"//trim(ny_str) - - read(nx_str,*)nx_MAPL - read(ny_str,*)ny_MAPL + nx_MAPL="" + ny_MAPL="" + open(10,file=fileT, form="formatted", status="old") + do i=1,5 + read(10,*) + enddo + read(10,*)file_ocn_lnd + do i=100,1,-1 + if(file_ocn_lnd(i:i).eq."-")then + file_ocn(1:i-1)=file_ocn_lnd(1:i-1) + exit + endif + enddo + read(10,*)nx_MAPL + read(10,*)ny_MAPL + nx_str="" + ny_str="" + write(nx_str,*)nx_MAPL + write(ny_str,*)ny_MAPL + res_MAPL="" + length = len( trim(adjustl(nx_str))//"x"//trim(adjustl(ny_str)) ) + res_MAPL(1:length)=trim(adjustl(nx_str))//"x"//trim(adjustl(ny_str)) + end subroutine get_domain_name @@ -596,8 +553,6 @@ subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) if(acc(lonc,latc)==0)then k=k+1 acc(lonc,latc)=1 - else - acc(lonc,latc)=acc(lonc,latc)+1 endif endif enddo @@ -640,8 +595,6 @@ subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns lonp(k)=lonc latp(k)=latc ns_map(lonc,latc)=k - else - acc(lonc,latc)=acc(lonc,latc)+1 endif endif enddo From 32822f3e9762666e30c21d1bb92e7e28e7db5c26 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Mon, 17 Jun 2024 11:06:28 -0400 Subject: [PATCH 44/55] fix a bug (missing fileT definition) in the get_domain_name() of the mk_runofftbl.f90 --- .../GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index af8031375..cfef92bbc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -401,7 +401,7 @@ subroutine get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) !nx_MAPL: number of lon of ocean domain, eg: 1440 !ny_MAPL: number of lat of ocean domain, eg: 1080 - character*100 :: nx_str,ny_str + character*100 :: nx_str,ny_str,fileT integer :: px,plats,plate,plons,plone,plonss,pocns,pocne integer :: nstr1,nstr2 integer :: i,length @@ -411,6 +411,7 @@ subroutine get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) res_MAPL="" nx_MAPL="" ny_MAPL="" + fileT = "til/"//trim(file)//".til" open(10,file=fileT, form="formatted", status="old") do i=1,5 read(10,*) From cbd311dbda8b9bba2e02bae2cef60b1755b79fd1 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Mon, 17 Jun 2024 15:55:45 -0400 Subject: [PATCH 45/55] changed example grid to "M6TP0072x0036" and rename var file to Gridname --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 96 +++++++++---------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index cfef92bbc..a5163767c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -16,7 +16,7 @@ program Runoff integer :: type, np,lnd, is,ie,ww integer :: numtrans, numclosed integer :: status - character*100 :: file, fileT, fileR, fileO, fileB + character*100 :: Gridname, fileT, fileR, fileO, fileB character*400 :: fileLL character*400 :: MAKE_BCS_INPUT_DIR @@ -25,7 +25,7 @@ program Runoff integer :: nxt, command_argument_count character*(128) :: arg - character*(128) :: Usage = "mk_runofftbl.x CF0012x6C_TM0072xTM0036-Pfafstetter" + character*(128) :: Usage = "mk_runofftbl.x M6TP0072x0036-Pfafstetter" character*(128) :: mapl_tp_file ! ------------------------------------------------------------------ @@ -47,17 +47,17 @@ program Runoff end if nxt = 1 - call get_command_argument(nxt, file) + call get_command_argument(nxt, Gridname) print *, " " - print*, "Working with input BCs string: ", file + print*, "Working with input BCs string: ", Gridname print *, " " ! ------------------------------------------------------------------ - fileT = "til/"//trim(file)//".til" ! input - fileR = "rst/"//trim(file)//".rst" ! input - fileO = "til/"//trim(file)//".trn" ! output - fileB = "til/"//trim(file)//".TRN" ! output + fileT = "til/"//trim(Gridname)//".til" ! input + fileR = "rst/"//trim(Gridname)//".rst" ! input + fileO = "til/"//trim(Gridname)//".trn" ! output + fileB = "til/"//trim(Gridname)//".TRN" ! output ! Read I and J indices of river outlets. ! These should all be ocean pixels @@ -92,7 +92,7 @@ program Runoff print *, "Determining river outlets to ocean:" print *, "- Output file: ", fileB print *, " " - call outlets_to_ocean(file,lons,lats,nx,ny) + call outlets_to_ocean(Gridname,lons,lats,nx,ny) open(10,file=fileT, form="formatted", status="old") @@ -306,11 +306,11 @@ end subroutine write_route_file ! ------------------------------------------------------------------------ ! The subroutine moves outlets of each land&Greenland gridcell (with endpoint to ocean only) - ! to the nearest ocean gridcell defiend by "file" and ocean mask if the origional outlets are not in the ocean. - subroutine outlets_to_ocean(file,lons,lats,nx,ny) + ! to the nearest ocean gridcell defiend by "Gridname" and ocean mask if the origional outlets are not in the ocean. + subroutine outlets_to_ocean(Gridname,lons,lats,nx,ny) integer, intent(in) :: nx,ny !number of lon and lat, eg: 43200 and 21600 in 30s resolution - character(len=*), intent(in) :: file !name of the domain, eg: CF0180x6C_TM1440xTM1080-Pfafstetter + character(len=*), intent(in) :: Gridname !name of the domain, eg: CF0180x6C_M6TP0072x0036-Pfafstetter integer, intent(inout) :: lons(nx,ny),lats(nx,ny) !lons(nx,ny): lon idx of outlets of each land&Greenland gridcell (with endpoint to ocean only) !lats(nx,ny): lat idx of outlets of each land&Greenland gridcell (with endpoint to ocean only) @@ -337,10 +337,10 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) real*8, allocatable, dimension(:) :: lat_lnd,lon_lnd integer :: i,j,l,k,status,type,np,flag,flag2 - call get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) + call get_domain_name(Gridname,Gridname_ocn,Gridname_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) allocate(rst_ocn(nx,ny),rst_ocn_lnd(nx,ny)) allocate(lon30s(nx),lat30s(ny)) - call read_rst_til_files(nx,ny,file_ocn,file_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) + call read_rst_til_files(nx,ny,Gridname_ocn,Gridname_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) !print *,"running outlets_num() ..." call outlets_num(rst_ocn_lnd,nl_ocn_lnd,nt_ocn_lnd,lons,lats,nx,ny,ns) !print *,"outlets num is ",ns @@ -388,38 +388,38 @@ subroutine outlets_to_ocean(file,lons,lats,nx,ny) end subroutine outlets_to_ocean !------------------------------------------------------------------------- -! This subroutine gets the name of 'file_ocn' and 'file_ocn_lnd' from the input name 'file'. +! This subroutine gets the name of 'Gridname_ocn' and 'file_ocn_lnd' from the input name 'Gridname'. ! It also gets resolution of the ocean domain. - subroutine get_domain_name(file,file_ocn,file_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) + subroutine get_domain_name(Gridname,Gridname_ocn,Gridname_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) - character(len=*), intent(in) :: file !input domain name, eg: CF0180x6C_TM1440xTM1080-Pfafstetter - character(len=*), intent(out) :: file_ocn,file_ocn_lnd,res_MAPL - !file_ocn: ocean domain name, eg: TM1440xTM1080 - !file_ocn_land: ocean-land domain name, eg: TM1440xTM1080-Pfafstetter - !res_MAPL: ocean resolution name, eg: 1440x1080 + character(len=*), intent(in) :: Gridname !input domain name, eg: CF0180x6C_M6TP0072x0036-Pfafstetter + character(len=*), intent(out) :: Gridname_ocn,Gridname_ocn_lnd,res_MAPL + !Gridname_ocn: ocean domain name, eg: M6TP0072x0036 + !Gridname_ocn_lnd: ocean-land domain name, eg: M6TP0072x0036-Pfafstetter + !res_MAPL: ocean resolution name, eg: M6TP0072x0036 integer, intent(out) :: nx_MAPL,ny_MAPL - !nx_MAPL: number of lon of ocean domain, eg: 1440 - !ny_MAPL: number of lat of ocean domain, eg: 1080 + !nx_MAPL: number of lon of ocean domain, eg: 72 + !ny_MAPL: number of lat of ocean domain, eg: 36 character*100 :: nx_str,ny_str,fileT integer :: px,plats,plate,plons,plone,plonss,pocns,pocne integer :: nstr1,nstr2 integer :: i,length - file_ocn="" - file_ocn_lnd="" + Gridname_ocn="" + Gridname_ocn_lnd="" res_MAPL="" nx_MAPL="" ny_MAPL="" - fileT = "til/"//trim(file)//".til" + fileT = "til/"//trim(Gridname)//".til" open(10,file=fileT, form="formatted", status="old") do i=1,5 read(10,*) enddo - read(10,*)file_ocn_lnd + read(10,*)Gridname_ocn_lnd do i=100,1,-1 - if(file_ocn_lnd(i:i).eq."-")then - file_ocn(1:i-1)=file_ocn_lnd(1:i-1) + if(Gridname_ocn_lnd(i:i).eq."-")then + Gridname_ocn(1:i-1)=Gridname_ocn_lnd(1:i-1) exit endif enddo @@ -438,17 +438,17 @@ end subroutine get_domain_name !------------------------------------------------------------------------- ! This subroutine reads rst and til files - subroutine read_rst_til_files(nx,ny,file_ocn,file_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) + subroutine read_rst_til_files(nx,ny,Gridname_ocn,Gridname_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) integer, intent(in) :: nx,ny !number of lon and lat, eg: 43200 and 21600 in 30s resolution - character(len=*), intent(in) :: file_ocn,file_ocn_lnd ! input filename, eg: TM1440xTM1080 and TM1440xTM1080-Pfafstetter + character(len=*), intent(in) :: Gridname_ocn,Gridname_ocn_lnd ! input filename, eg: M6TP0072x0036 and M6TP0072x0036-Pfafstetter integer, intent(out) :: rst_ocn(nx,ny),rst_ocn_lnd(nx,ny) !data from rst files - integer,pointer,intent(out), dimension(:) :: t2loni,t2lati !relationship between ocn tile idx in TM1440xTM1080.rst and lat/lon idx in MAPL_Tripolar.nc + integer,pointer,intent(out), dimension(:) :: t2loni,t2lati !relationship between ocn tile idx in M6TP0072x0036.rst and lat/lon idx in MAPL_Tripolar.nc integer, intent(out) :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn - !nt_ocn_lnd: number of total tiles in the TM1440xTM1080-Pfafstetter - !nl_ocn_lnd: number of land tiles in the TM1440xTM1080-Pfafstetter - !nt_ocn: number of total tiles in the TM1440xTM1080 + !nt_ocn_lnd: number of total tiles in the M6TP0072x0036-Pfafstetter + !nl_ocn_lnd: number of land tiles in the M6TP0072x0036-Pfafstetter + !nt_ocn: number of total tiles in the M6TP0072x0036 real*8, intent(out) :: lon30s(nx),lat30s(ny)!lon and lat value arrays of the 30s map character*100 :: fileT_ocn, fileR_ocn @@ -457,10 +457,10 @@ subroutine read_rst_til_files(nx,ny,file_ocn,file_ocn_lnd,rst_ocn,rst_ocn_lnd,t2 real :: num1,num2,num3,num4 real*8 :: dx,dy - fileT_ocn = "til/"//trim(file_ocn)//".til" ! input - fileR_ocn = "rst/"//trim(file_ocn)//".rst" ! input - fileT_ocn_lnd = "til/"//trim(file_ocn_lnd)//".til" ! input - fileR_ocn_lnd = "rst/"//trim(file_ocn_lnd)//".rst" ! input + fileT_ocn = "til/"//trim(Gridname_ocn)//".til" ! input + fileR_ocn = "rst/"//trim(Gridname_ocn)//".rst" ! input + fileT_ocn_lnd = "til/"//trim(Gridname_ocn_lnd)//".til" ! input + fileR_ocn_lnd = "rst/"//trim(Gridname_ocn_lnd)//".rst" ! input !print *, "Reading rst file "//trim(fileR_ocn) open(20,file=fileR_ocn,form="unformatted",status="old") @@ -523,7 +523,7 @@ subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) !nl: number of land tiles !nt: number of total tiles integer, intent(inout) :: lons(nx,ny),lats(nx,ny) !map of lon/lat idx of outlets for each cells on the 30s map - integer, intent(in) :: rst_ocn_lnd(nx,ny) !map of tile idx from ocean-land rst map, eg: from TM1440xTM1080-Pfafstetter.rst + integer, intent(in) :: rst_ocn_lnd(nx,ny) !map of tile idx from ocean-land rst map, eg: from M6TP0072x0036-Pfafstetter.rst integer, intent(out) :: ns !number of the outlets integer, allocatable, dimension(:) :: lonp,latp @@ -611,15 +611,15 @@ subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns end subroutine retrieve_outlets !------------------------------------------------------------------------ - ! convert the ocean mask in MAPL_Tripolar.nc to 1d list for each ocean tile defined by ocn rst, eg: TM1440xTM1080.rst + ! convert the ocean mask in MAPL_Tripolar.nc to 1d list for each ocean tile defined by ocn rst, eg: M6TP0072x0036.rst subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) integer, intent(in) :: nt,nlon,nlat !nt: number of ocean tiles - !nlon: number of lon in MAPL_Tripolar.nc, eg 1440 - !nlat: number of lat in MAPL_Tripolar.nc, eg 1080 - integer, intent(in) :: t2loni(nt),t2lati(nt) !relationship between ocn tile idx in TM1440xTM1080.rst and lat/lon idx in MAPL_Tripolar.nc - character(len=*), intent(in) :: res_MAPL !name of the ocean resolution, eg 1440x1080 + !nlon: number of lon in MAPL_Tripolar.nc, eg 72 + !nlat: number of lat in MAPL_Tripolar.nc, eg 36 + integer, intent(in) :: t2loni(nt),t2lati(nt) !relationship between ocn tile idx in M6TP0072x0036.rst and lat/lon idx in MAPL_Tripolar.nc + character(len=*), intent(in) :: res_MAPL !name of the ocean resolution, eg M6TP0072x0036 integer, intent(out) :: msk_tile(nt) !1d list for the ocean msk for each ocean tile real, allocatable, dimension(:,:) :: msk_MAPL @@ -709,7 +709,7 @@ subroutine mask_MAPL_2d(ocean,mask1d,msk2d,nt,nlon,nlat) !nt: number of ocean tiles !nlon: number of lon in 30s map, eg 43200 !nlat: number of lat in 30s map, eg 21600 - integer, intent(in) :: ocean(nlon,nlat) !tile idx from ocn rst file, eg: from TM1440xTM1080.rst + integer, intent(in) :: ocean(nlon,nlat) !tile idx from ocn rst file, eg: from M6TP0072x0036.rst integer, intent(in) :: mask1d(nt) !1d list of ocn mask got from subroutine mask_MAPL_1d integer, intent(out) :: msk2d(nlon,nlat) !output of the ocn mask on the 30s map @@ -726,7 +726,7 @@ subroutine mask_MAPL_2d(ocean,mask1d,msk2d,nt,nlon,nlat) end subroutine mask_MAPL_2d !------------------------------------------------------------------------ - ! further mask the ocn mask from MAPL_Tripolar.nc based on the land-ocean rst eg: TM1440xTM1080-Pfafstetter.rst + ! further mask the ocn mask from MAPL_Tripolar.nc based on the land-ocean rst eg: M6TP0072x0036-Pfafstetter.rst subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) integer,intent(in) :: nlon,nlat,nl,nt @@ -734,7 +734,7 @@ subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) !nlat: number of lat in 30s map, eg 21600 !nl: number of lnd tile !nt: number of total tile - integer,intent(in) :: rst_ocn_lnd(nlon,nlat) !tile idx from land-ocean rst eg: TM1440xTM1080-Pfafstetter.rst + integer,intent(in) :: rst_ocn_lnd(nlon,nlat) !tile idx from land-ocean rst eg: M6TP0072x0036-Pfafstetter.rst integer,intent(in) :: mask_mapl(nlon,nlat) !ocn mask map from subroutine mask_MAPL_2d integer,intent(out) :: mask(nlon,nlat) !ocn mask map masked further by land-ocean rst From b71f1068d263ba16dbb08d94d11f390f147b3fab Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Mon, 17 Jun 2024 16:02:52 -0400 Subject: [PATCH 46/55] fix a small bug --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index a5163767c..7201b1ad4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -325,8 +325,8 @@ subroutine outlets_to_ocean(Gridname,lons,lats,nx,ny) real*8, allocatable, dimension(:) :: lonsh,latsh real*8, allocatable, dimension(:) :: lons_adj,lats_adj integer, allocatable, dimension(:) :: lati_ocn,loni_ocn - character*100 :: file_ocn - character*100 :: file_ocn_lnd + character*100 :: Gridname_ocn + character*100 :: Gridname_ocn_lnd character*100 :: res_MAPL integer, allocatable, dimension(:,:) :: rst_ocn,rst_ocn_lnd integer :: nt_ocn_lnd,nl_ocn_lnd,nt_ocn,nx_MAPL,ny_MAPL,nsh From d17d85289657f4ccd34eb9df82556d8dd13ddb08 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Mon, 17 Jun 2024 16:27:30 -0400 Subject: [PATCH 47/55] documentation added in mk_runofftble.f90 --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 20 ++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 7201b1ad4..e546cc695 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -1,4 +1,22 @@ program Runoff + +! !INTERFACE: +! +! !ARGUMENTS: +! +! Usage = "mk_runofftbl.x Gridname" +! Gridname: a string that describes the grids associated with the atmosphere and ocean model configuration +! eg, CF0180x6C_M6TP0072x0036-Pfafstetter +! +! This program is used to generate the runoff table *.trn and *.TRN files that are used in the Catchment Land model +! for directing runoff to its sink in ocean. The input are bcs geometry files associated with the Gridname and a +! binary file Outlet_latlon.43200x21600 that saves the outlets locations in land (this file can be created by running +! GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py). +! The program first moves the outlet locations in land to their nearest ocean pixels by calling outlets_to_ocean, +! and then generates runoff table files. +! +! Yujin Zeng - June 17, 2024 +! Email: yujin.zeng@nasa.gov use mapl_hashmod use mapl_sortmod @@ -25,7 +43,7 @@ program Runoff integer :: nxt, command_argument_count character*(128) :: arg - character*(128) :: Usage = "mk_runofftbl.x M6TP0072x0036-Pfafstetter" + character*(128) :: Usage = "mk_runofftbl.x CF0180x6C_M6TP0072x0036-Pfafstetter" character*(128) :: mapl_tp_file ! ------------------------------------------------------------------ From 349249f61254b8a81f7a145f15ee0f0b11cd9944 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 18 Jun 2024 12:27:36 -0400 Subject: [PATCH 48/55] edited documentation and comments in mk_runofftbl.F90 --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 64 ++++++++++++------- 1 file changed, 42 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index e546cc695..7f8b423a4 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -1,19 +1,21 @@ -program Runoff +program mk_runofftbl ! !INTERFACE: ! ! !ARGUMENTS: ! ! Usage = "mk_runofftbl.x Gridname" +! ! Gridname: a string that describes the grids associated with the atmosphere and ocean model configuration ! eg, CF0180x6C_M6TP0072x0036-Pfafstetter ! -! This program is used to generate the runoff table *.trn and *.TRN files that are used in the Catchment Land model -! for directing runoff to its sink in ocean. The input are bcs geometry files associated with the Gridname and a -! binary file Outlet_latlon.43200x21600 that saves the outlets locations in land (this file can be created by running -! GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py). -! The program first moves the outlet locations in land to their nearest ocean pixels by calling outlets_to_ocean, -! and then generates runoff table files. +! This program generates the runoff table *.trn and *.TRN files that are used in the Catchment model for +! directing runoff to its ocean sink. The inputs are (i) bcs geometry files associated with the Gridname +! and (ii) a binary file ("Outlet_latlon.43200x21600") that provides the land raster grid cells where the +! outlets are located. The latter file is created by [..]/Raster/preproc/routing/run_routing_raster.py. +! The program first moves the outlet locations from the land raster grid cells to the nearest ocean pixels +! by calling outlets_to_ocean() and then generates the runoff table files. +! The program currently works only for the MOM5 and MOM6 tripolar ocean grids. ! ! Yujin Zeng - June 17, 2024 ! Email: yujin.zeng@nasa.gov @@ -276,14 +278,18 @@ program Runoff ! Write output files ! ------------------- - print *, "Writing output file..." + print *, "Writing output files..." + ! ASCII file (*.trn) + open(10,file=fileO, form="formatted", status="unknown") write(10,*) NumTrans do k=1,NumTrans write(10,"(2I10,f16.8)") SrcTile(k),DstTile(k),SrcFraction(k) end do close(10) + + ! binary file (*.TRN) call write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) @@ -323,8 +329,9 @@ subroutine write_route_file( fileB, NumTrans, SrcTile, DstTile, SrcFraction) end subroutine write_route_file ! ------------------------------------------------------------------------ - ! The subroutine moves outlets of each land&Greenland gridcell (with endpoint to ocean only) - ! to the nearest ocean gridcell defiend by "Gridname" and ocean mask if the origional outlets are not in the ocean. + ! The subroutine moves outlets of each land & Greenland gridcell (with endpoint to ocean only) + ! to the nearest ocean gridcell defiend by "Gridname" and ocean mask if the original outlets are not in the ocean. + subroutine outlets_to_ocean(Gridname,lons,lats,nx,ny) integer, intent(in) :: nx,ny !number of lon and lat, eg: 43200 and 21600 in 30s resolution @@ -405,9 +412,9 @@ subroutine outlets_to_ocean(Gridname,lons,lats,nx,ny) end subroutine outlets_to_ocean -!------------------------------------------------------------------------- -! This subroutine gets the name of 'Gridname_ocn' and 'file_ocn_lnd' from the input name 'Gridname'. -! It also gets resolution of the ocean domain. + !------------------------------------------------------------------------- + ! This subroutine gets the name of 'Gridname_ocn' and 'Gridname_ocn_lnd' from the input name 'Gridname'. + ! It also gets the resolution of the ocean domain. subroutine get_domain_name(Gridname,Gridname_ocn,Gridname_ocn_lnd,res_MAPL,nx_MAPL,ny_MAPL) character(len=*), intent(in) :: Gridname !input domain name, eg: CF0180x6C_M6TP0072x0036-Pfafstetter @@ -454,8 +461,9 @@ subroutine get_domain_name(Gridname,Gridname_ocn,Gridname_ocn_lnd,res_MAPL,nx_MA end subroutine get_domain_name -!------------------------------------------------------------------------- -! This subroutine reads rst and til files + !------------------------------------------------------------------------- + ! This subroutine reads rst and til files + subroutine read_rst_til_files(nx,ny,Gridname_ocn,Gridname_ocn_lnd,rst_ocn,rst_ocn_lnd,t2loni,t2lati,nt_ocn_lnd,nl_ocn_lnd,nt_ocn,lon30s,lat30s) integer, intent(in) :: nx,ny !number of lon and lat, eg: 43200 and 21600 in 30s resolution @@ -531,8 +539,9 @@ subroutine read_rst_til_files(nx,ny,Gridname_ocn,Gridname_ocn_lnd,rst_ocn,rst_oc end subroutine read_rst_til_files -!------------------------------------------------------------------------- - ! This subroutine counts the number of outlet points from input outlets lon/lat idx map. + !------------------------------------------------------------------------- + ! This subroutine counts the number of outlet points from input outlets lon/lat idx map. + subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) integer, intent(in) :: nx,ny,nl,nt @@ -582,8 +591,9 @@ subroutine outlets_num(rst_ocn_lnd,nl,nt,lons,lats,nx,ny,ns) end subroutine outlets_num !------------------------------------------------------------------------ - ! This subroutine retrives the outlets locations from the outlets map (nx,ny) to a list (ns) - ! It also stores the outlets idx on the 30s map + ! This subroutine retrieves the outlet locations from the outlets map (nx,ny) to a list (ns). + ! It also stores the outlets idx on the 30s map. + subroutine retrieve_outlets(lons,lats,lon30s,lat30s,lonp,latp,lon_lnd,lat_lnd,ns_map,nx,ny,ns) integer, intent(in) :: nx,ny,ns @@ -630,6 +640,7 @@ end subroutine retrieve_outlets !------------------------------------------------------------------------ ! convert the ocean mask in MAPL_Tripolar.nc to 1d list for each ocean tile defined by ocn rst, eg: M6TP0072x0036.rst + subroutine mask_MAPL_1d(msk_tile,t2loni,t2lati,nt,res_MAPL,nlon,nlat) integer, intent(in) :: nt,nlon,nlat @@ -656,6 +667,7 @@ end subroutine mask_MAPL_1d !------------------------------------------------------------------------ ! read ocean mask from "MAPL_Tripolar.nc" + subroutine read_oceanModel_mapl(res_MAPL,wetMask,nx,ny) @@ -721,6 +733,7 @@ end subroutine endrun !------------------------------------------------------------------------ ! convert 1d list of ocn mask to a 30s map + subroutine mask_MAPL_2d(ocean,mask1d,msk2d,nt,nlon,nlat) integer, intent(in) :: nt,nlon,nlat @@ -745,6 +758,7 @@ end subroutine mask_MAPL_2d !------------------------------------------------------------------------ ! further mask the ocn mask from MAPL_Tripolar.nc based on the land-ocean rst eg: M6TP0072x0036-Pfafstetter.rst + subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) integer,intent(in) :: nlon,nlat,nl,nt @@ -766,7 +780,8 @@ subroutine mask_MAPL_bcs(rst_ocn_lnd,mask_mapl,mask,nlon,nlat,nl,nt) end subroutine mask_MAPL_bcs !------------------------------------------------------------------------ - !find the ocean boundary cells (that are next to non-ocean cell) on the 30s map based on the ocn mask from mask_MAPL_bcs + ! find the ocean boundary cells (that are next to non-ocean cell) on the 30s map based on the ocn mask from mask_MAPL_bcs + subroutine ocean_boundary(mask,boundary,nlon,nlat) integer, intent(in) :: nlon,nlat @@ -804,7 +819,8 @@ subroutine ocean_boundary(mask,boundary,nlon,nlat) end subroutine ocean_boundary !------------------------------------------------------------------------ - ! counting the number of ocean boundary cells + ! count the number of ocean boundary cells + subroutine ocean_boundary_num(boundary,nlon,nlat,nsh) integer, intent(in) :: nlon,nlat @@ -829,6 +845,7 @@ end subroutine ocean_boundary_num !------------------------------------------------------------------------ ! list the lat and lon of ocean boundary cells + subroutine ocean_boundary_points(boundary,lon30s,lat30s,lonsh,latsh,nlon,nlat,nsh) integer,intent(in) :: nlon,nlat,nsh @@ -854,6 +871,7 @@ end subroutine ocean_boundary_points !------------------------------------------------------------------------ ! move the outlet locations to the nearest ocean boundary cell + subroutine move_to_ocean(lonsi,latsi,lons,lats,mask,lonsh,latsh,lons_adj,lats_adj,ns,nlon,nlat,nsh) integer, intent(in) :: ns,nlon,nlat,nsh @@ -902,6 +920,7 @@ end subroutine move_to_ocean !------------------------------------------------------------------------ !convert the lon and lat values of the outlets to lon and lat idx on the 30s map + subroutine sinkxy_ocean(lons,lats,lon30s,lat30s,loni,lati,ns,nlon,nlat) integer, intent(in) :: ns,nlon,nlat @@ -934,6 +953,7 @@ end subroutine sinkxy_ocean !------------------------------------------------------------------------ ! put the list of lon and lat idx of the outlets back to the 30s map lons(nx,ny),lats(nx,ny) + subroutine update_outlets(loni_ocn,lati_ocn,ns_map,lons,lats,nx,ny,ns) integer,intent(in) :: nx,ny,ns @@ -968,6 +988,6 @@ end subroutine update_outlets !------------------------------------------------------------------------ -end program Runoff +end program mk_runofftbl ! ============================ EOF ===================================================== From 0d8b396b9c5571066b2da749430b8ff3216feff6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 18 Jun 2024 12:55:10 -0400 Subject: [PATCH 49/55] cleaned up specification of path to bcs_shared directory (run_routing_raster.py) --- .../preproc/routing/run_routing_raster.py | 30 +++++++++++-------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py index aa135e5cd..c76a06062 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/preproc/routing/run_routing_raster.py @@ -5,22 +5,26 @@ import os import subprocess +# Path to "bcs_shared" directory: + +file_path = "/discover/nobackup/projects/gmao/bcs_shared/" # NCCS Discover +#file_path = "/nobackup/gmao_SIteam/ModelData/bcs_shared/" # NAS + # Input files -# For NAS users, please replace the Discover base path "/discover/nobackup/projects/gmao/bcs_shared/" -# by the NAS path "/nobackup/gmao_SIteam/ModelData/bcs_shared/" -file_Pfafcatch="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat" -file_SRTMPfaf="/discover/nobackup/projects/gmao/bcs_shared/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc" -file_Drainage="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/HydroSHEDS_drainage_area.nc" -file_GrnLat="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lat.txt" -file_GrnLon="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lon.txt" -file_GrnMap="/discover/nobackup/projects/gmao/bcs_shared/preprocessing_bcs_inputs/land/routing/GreenlandID_30s.nc" + +file_Pfafcatch = file_path + "/make_bcs_inputs/land/topo/v1/SRTM-TopoData/Pfafcatch-routing.dat" +file_SRTMPfaf = file_path + "/make_bcs_inputs/land/topo/v1/SRTM-TopoData/SRTM_PfafData.nc" +file_Drainage = file_path + "/preprocessing_bcs_inputs/land/routing/HydroSHEDS_drainage_area.nc" +file_GrnLat = file_path + "/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lat.txt" +file_GrnLon = file_path + "/preprocessing_bcs_inputs/land/routing/Greenland_outlets_lon.txt" +file_GrnMap = file_path + "/preprocessing_bcs_inputs/land/routing/GreenlandID_30s.nc" name_Pfafcatch = os.path.basename(file_Pfafcatch) -name_SRTMPfaf = os.path.basename(file_SRTMPfaf) -name_Drainage = os.path.basename(file_Drainage) -name_GrnLat =os.path.basename(file_GrnLat) -name_GrnLon = os.path.basename(file_GrnLon) -name_GrnMap = os.path.basename(file_GrnMap) +name_SRTMPfaf = os.path.basename(file_SRTMPfaf) +name_Drainage = os.path.basename(file_Drainage) +name_GrnLat = os.path.basename(file_GrnLat) +name_GrnLon = os.path.basename(file_GrnLon) +name_GrnMap = os.path.basename(file_GrnMap) files=[file_Pfafcatch,file_SRTMPfaf,file_Drainage,file_GrnLat,file_GrnLon,file_GrnMap] # Remove files and directories From d61431266112fd2e44b84f201d875941d3ac8d8e Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 18 Jun 2024 14:01:04 -0400 Subject: [PATCH 50/55] nx_MAPL=-9999 and ny_MAPL=-9999 --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 7f8b423a4..6d86f99c3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -434,8 +434,8 @@ subroutine get_domain_name(Gridname,Gridname_ocn,Gridname_ocn_lnd,res_MAPL,nx_MA Gridname_ocn="" Gridname_ocn_lnd="" res_MAPL="" - nx_MAPL="" - ny_MAPL="" + nx_MAPL=-9999 + ny_MAPL=-9999 fileT = "til/"//trim(Gridname)//".til" open(10,file=fileT, form="formatted", status="old") do i=1,5 From 6b1395d18431392e9d8e3547dfdcfc5e7e2e662d Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 21 Jun 2024 14:40:28 -0400 Subject: [PATCH 51/55] version information added in mk_runofftble.f90 --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 62 +++++++++++++++---- 1 file changed, 50 insertions(+), 12 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 6d86f99c3..5fd07ed1f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -4,10 +4,11 @@ program mk_runofftbl ! ! !ARGUMENTS: ! -! Usage = "mk_runofftbl.x Gridname" +! Usage = "mk_runofftbl.x -g Gridname -v LBCSV" ! -! Gridname: a string that describes the grids associated with the atmosphere and ocean model configuration +! -g: Gridname: a string that describes the grids associated with the atmosphere and ocean model configuration ! eg, CF0180x6C_M6TP0072x0036-Pfafstetter +! -v: LBCSV : Land bcs version (F25, GM4, ICA, NL3, NL4, NL5, v06, v07, v08, v09, v10, v11, v12, ...) ! ! This program generates the runoff table *.trn and *.TRN files that are used in the Catchment model for ! directing runoff to its ocean sink. The inputs are (i) bcs geometry files associated with the Gridname @@ -45,18 +46,19 @@ program mk_runofftbl integer :: nxt, command_argument_count character*(128) :: arg - character*(128) :: Usage = "mk_runofftbl.x CF0180x6C_M6TP0072x0036-Pfafstetter" - character*(128) :: mapl_tp_file + character*(128) :: Usage = "mk_runofftbl.x -g CF0180x6C_M6TP0072x0036-Pfafstetter -v v12" + character*5 :: LBCSV = 'UNDEF' + character*5 :: OUTLETV = 'UNDEF' + character*1 :: opt ! ------------------------------------------------------------------ call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) - fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/Outlet_latlon.' ! Read inputs ----------------------------------------------------- I = command_argument_count() - if (I /= 1) then + if (I /= 4) then print *, " " print *, "Wrong number of input arguments, got: ", I print *, "Example usage with defaults: " @@ -65,12 +67,45 @@ program mk_runofftbl print *, " " call exit(1) end if - + nxt = 1 - call get_command_argument(nxt, Gridname) - print *, " " - print*, "Working with input BCs string: ", Gridname - print *, " " + call get_command_argument(nxt,arg) + do while(arg(1:1)=='-') + opt=arg(2:2) + if(len(trim(arg))==2) then + nxt = nxt + 1 + call get_command_argument(nxt,arg) + else + arg = arg(3:) + end if + select case (opt) + case ('g') + Gridname = trim(arg) + case ('v') + LBCSV = trim(arg) + case default + print *, "Wrong flag -", opt + print *, "Example usage with defaults: " + print *, trim(Usage) + call exit(1) + end select + nxt = nxt + 1 + call get_command_argument(nxt,arg) + end do + + if(trim(LBCSV)=="v11")then + OUTLETV="v1" + else if(trim(LBCSV)=="v12")then + OUTLETV="v2" + else + OUTLETV="others" + endif + + if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then + fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' + else + fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/v1/Outlet_latlon.' + endif ! ------------------------------------------------------------------ @@ -112,7 +147,10 @@ program mk_runofftbl print *, "Determining river outlets to ocean:" print *, "- Output file: ", fileB print *, " " - call outlets_to_ocean(Gridname,lons,lats,nx,ny) + + if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then + call outlets_to_ocean(Gridname,lons,lats,nx,ny) + endif open(10,file=fileT, form="formatted", status="old") From ecda6498e556c03a331424d9f2dc080a93af7183 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Fri, 21 Jun 2024 15:13:12 -0400 Subject: [PATCH 52/55] Add documentation for version information in mk_runofftbl.f90 and add version arg in make_bcs_latlon.py and make_bcs_cube.py --- .../Utils/Raster/makebcs/make_bcs_cube.py | 2 +- .../Utils/Raster/makebcs/make_bcs_latlon.py | 2 +- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 16 +++++++++++++--- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py index 78506693c..50287a2a3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py @@ -53,7 +53,7 @@ /bin/mv rst/Pfafstetter-M.rst rst/Pfafstetter.rst bin/CombineRasters.x -f 0 -t {NT} {OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO} Pfafstetter >/dev/null bin/CombineRasters.x -t {NT} CF{NC}x6C{SGNAME} {OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter - bin/mk_runofftbl.x CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter + bin/mk_runofftbl.x -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS 1 if ({SKIPLAND} != True) bin/mkCatchParam.x -x {NX} -y {NY} -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} endif diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py index e6e7844e6..d552f7ae4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py @@ -41,7 +41,7 @@ /bin/mv rst/Pfafstetter-M.rst rst/Pfafstetter.rst bin/CombineRasters.x -f 0 -t {NT} {DATENAME}{IMO}x{POLENAME}{JMO} Pfafstetter >/dev/null bin/CombineRasters.x -t {NT} DC{IM}xPC{JM} {DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter - bin/mk_runofftbl.x DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter + bin/mk_runofftbl.x -g DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS 1 if ( {SKIPLAND} != True ) bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS {NCPUS} diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 5fd07ed1f..01938473f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -13,10 +13,20 @@ program mk_runofftbl ! This program generates the runoff table *.trn and *.TRN files that are used in the Catchment model for ! directing runoff to its ocean sink. The inputs are (i) bcs geometry files associated with the Gridname ! and (ii) a binary file ("Outlet_latlon.43200x21600") that provides the land raster grid cells where the -! outlets are located. The latter file is created by [..]/Raster/preproc/routing/run_routing_raster.py. +! outlets are located. The latter file is either created by [..]/Raster/preproc/routing/run_routing_raster.py +! or from Randy's (Randal.d.koster@nasa.gov) old file under {MAKE_BCS_INPUT_DIR}/land/route/v1. ! The program first moves the outlet locations from the land raster grid cells to the nearest ocean pixels -! by calling outlets_to_ocean() and then generates the runoff table files. -! The program currently works only for the MOM5 and MOM6 tripolar ocean grids. +! by calling outlets_to_ocean() (only with bcs version v11, v12 or later) and then generates the runoff table files. +! The program outlets_to_ocean() currently works only for the MOM5 and MOM6 tripolar ocean grids. +! +!Basically based on bcs version we would use have these 3 options: +!======================================================= +!bcs version --> Outlet lat/lon file version +!--------------------------------------------------- +!v12 --> (new) v2 (produced with Yujin's pre-processing routines) +!v11 --> (old) v1 (produced with Randy's old file) +!otherwise --> n/a (produced with Randy's old file, but do not move outlet locations to ocean) +!========================================================= ! ! Yujin Zeng - June 17, 2024 ! Email: yujin.zeng@nasa.gov From 303b84f5edf1ef7aea996d9bfe134ed63b9e5832 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 2 Jul 2024 16:33:39 -0400 Subject: [PATCH 53/55] outlet version definition was moved to rmTinyCatchParaMod.F90 --- .../Utils/Raster/makebcs/make_bcs_cube.py | 6 ++- .../Utils/Raster/makebcs/make_bcs_latlon.py | 6 ++- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 40 +++++++------------ .../Raster/makebcs/rmTinyCatchParaMod.F90 | 13 ++++++ 4 files changed, 36 insertions(+), 29 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py index 50287a2a3..461a8081f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py @@ -53,9 +53,11 @@ /bin/mv rst/Pfafstetter-M.rst rst/Pfafstetter.rst bin/CombineRasters.x -f 0 -t {NT} {OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO} Pfafstetter >/dev/null bin/CombineRasters.x -t {NT} CF{NC}x6C{SGNAME} {OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter - bin/mk_runofftbl.x -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS 1 - if ({SKIPLAND} != True) bin/mkCatchParam.x -x {NX} -y {NY} -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} + if ({SKIPLAND} != True) then + bin/mkCatchParam.x -x {NX} -y {NY} -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} + bin/mk_runofftbl.x -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter + endif endif if ( {STEP2} == True ) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py index d552f7ae4..16a8e821c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py @@ -41,9 +41,11 @@ /bin/mv rst/Pfafstetter-M.rst rst/Pfafstetter.rst bin/CombineRasters.x -f 0 -t {NT} {DATENAME}{IMO}x{POLENAME}{JMO} Pfafstetter >/dev/null bin/CombineRasters.x -t {NT} DC{IM}xPC{JM} {DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter - bin/mk_runofftbl.x -g DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS 1 - if ( {SKIPLAND} != True ) bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} + if ( {SKIPLAND} != True ) then + bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} + bin/mk_runofftbl.x -g DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter + endif setenv OMP_NUM_THREADS {NCPUS} if ( {SKIPLAND} != True ) bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} chmod 755 bin/create_README.csh diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 01938473f..e9321635e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -4,11 +4,10 @@ program mk_runofftbl ! ! !ARGUMENTS: ! -! Usage = "mk_runofftbl.x -g Gridname -v LBCSV" +! Usage = "mk_runofftbl.x -g Gridname" ! ! -g: Gridname: a string that describes the grids associated with the atmosphere and ocean model configuration ! eg, CF0180x6C_M6TP0072x0036-Pfafstetter -! -v: LBCSV : Land bcs version (F25, GM4, ICA, NL3, NL4, NL5, v06, v07, v08, v09, v10, v11, v12, ...) ! ! This program generates the runoff table *.trn and *.TRN files that are used in the Catchment model for ! directing runoff to its ocean sink. The inputs are (i) bcs geometry files associated with the Gridname @@ -16,8 +15,8 @@ program mk_runofftbl ! outlets are located. The latter file is either created by [..]/Raster/preproc/routing/run_routing_raster.py ! or from Randy's (Randal.d.koster@nasa.gov) old file under {MAKE_BCS_INPUT_DIR}/land/route/v1. ! The program first moves the outlet locations from the land raster grid cells to the nearest ocean pixels -! by calling outlets_to_ocean() (only with bcs version v11, v12 or later) and then generates the runoff table files. -! The program outlets_to_ocean() currently works only for the MOM5 and MOM6 tripolar ocean grids. +! by calling outlets_to_ocean() and then generates the runoff table files. +! The subroutine outlets_to_ocean() currently works only for the MOM5 and MOM6 tripolar ocean grids. ! !Basically based on bcs version we would use have these 3 options: !======================================================= @@ -25,7 +24,7 @@ program mk_runofftbl !--------------------------------------------------- !v12 --> (new) v2 (produced with Yujin's pre-processing routines) !v11 --> (old) v1 (produced with Randy's old file) -!otherwise --> n/a (produced with Randy's old file, but do not move outlet locations to ocean) +!otherwise --> N/A (do not run routing module of make_bcs) !========================================================= ! ! Yujin Zeng - June 17, 2024 @@ -33,6 +32,7 @@ program mk_runofftbl use mapl_hashmod use mapl_sortmod + use rmTinyCatchParaMod, only :: OUTLETV use netcdf implicit none @@ -57,13 +57,18 @@ program mk_runofftbl integer :: nxt, command_argument_count character*(128) :: arg character*(128) :: Usage = "mk_runofftbl.x -g CF0180x6C_M6TP0072x0036-Pfafstetter -v v12" - character*5 :: LBCSV = 'UNDEF' - character*5 :: OUTLETV = 'UNDEF' character*1 :: opt ! ------------------------------------------------------------------ call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) + + if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then + fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' + else + print *, "Routing files will not be produced with the selected land BCs version" + stop + endif ! Read inputs ----------------------------------------------------- @@ -91,8 +96,6 @@ program mk_runofftbl select case (opt) case ('g') Gridname = trim(arg) - case ('v') - LBCSV = trim(arg) case default print *, "Wrong flag -", opt print *, "Example usage with defaults: " @@ -103,19 +106,8 @@ program mk_runofftbl call get_command_argument(nxt,arg) end do - if(trim(LBCSV)=="v11")then - OUTLETV="v1" - else if(trim(LBCSV)=="v12")then - OUTLETV="v2" - else - OUTLETV="others" - endif - - if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then - fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' - else - fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/v1/Outlet_latlon.' - endif + print *, " " + print*, "Working with input BCs grid: ", trim(Gridname) ! ------------------------------------------------------------------ @@ -158,9 +150,7 @@ program mk_runofftbl print *, "- Output file: ", fileB print *, " " - if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then - call outlets_to_ocean(Gridname,lons,lats,nx,ny) - endif + call outlets_to_ocean(Gridname,lons,lats,nx,ny) open(10,file=fileT, form="formatted", status="old") diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 index ad373f92d..ae912008b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 @@ -52,6 +52,7 @@ module rmTinyCatchParaMod character*6, public, save :: SOILBCS = 'UNDEF' character*6, public, save :: MODALB = 'UNDEF' character*10, public, save :: SNOWALB = 'UNDEF' + character*5, public, save :: OUTLETV = 'UNDEF' REAL, public, save :: GNU = MAPL_UNDEF character*512 :: MAKE_BCS_INPUT_DIR @@ -103,6 +104,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'NGDC' MODALB = 'MODIS1' SNOWALB = 'LUT' + OUTLETV = "N/A" GNU = 2.17 use_PEATMAP = .false. jpl_height = .false. @@ -112,6 +114,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'NGDC' MODALB = 'MODIS2' SNOWALB = 'LUT' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .false. jpl_height = .false. @@ -121,6 +124,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'LUT' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .false. jpl_height = .false. @@ -130,6 +134,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'LUT' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .false. jpl_height = .true. @@ -139,6 +144,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'LUT' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .true. jpl_height = .true. @@ -148,6 +154,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'MODC061' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .true. jpl_height = .true. @@ -157,6 +164,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'LUT' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .true. jpl_height = .false. @@ -166,6 +174,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'MODC061' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .false. jpl_height = .false. @@ -175,6 +184,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'MODC061' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .true. jpl_height = .false. @@ -184,6 +194,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'MODC061v2' + OUTLETV = "N/A" GNU = 1.0 use_PEATMAP = .true. jpl_height = .false. @@ -193,6 +204,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD' MODALB = 'MODIS2' SNOWALB = 'MODC061v2' + OUTLETV = "v1" GNU = 1.0 use_PEATMAP = .true. jpl_height = .true. @@ -202,6 +214,7 @@ SUBROUTINE init_bcs_config (LBCSV) SOILBCS = 'HWSD_b' MODALB = 'MODIS2' SNOWALB = 'MODC061v2' + OUTLETV = "v2" GNU = 1.0 use_PEATMAP = .true. jpl_height = .true. From a54f139cdd404fa46c2c7f07dd4bf762636e8973 Mon Sep 17 00:00:00 2001 From: Yujin Zeng Date: Tue, 2 Jul 2024 20:13:14 -0400 Subject: [PATCH 54/55] fixed bugs, now the correct version information can be read in mk_runofftbl.f90 --- .../Utils/Raster/makebcs/make_bcs_cube.py | 6 ++--- .../Utils/Raster/makebcs/make_bcs_latlon.py | 6 ++--- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 24 ++++++++++--------- 3 files changed, 17 insertions(+), 19 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py index 461a8081f..50287a2a3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_cube.py @@ -53,11 +53,9 @@ /bin/mv rst/Pfafstetter-M.rst rst/Pfafstetter.rst bin/CombineRasters.x -f 0 -t {NT} {OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO} Pfafstetter >/dev/null bin/CombineRasters.x -t {NT} CF{NC}x6C{SGNAME} {OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter + bin/mk_runofftbl.x -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS 1 - if ({SKIPLAND} != True) then - bin/mkCatchParam.x -x {NX} -y {NY} -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} - bin/mk_runofftbl.x -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter - endif + if ({SKIPLAND} != True) bin/mkCatchParam.x -x {NX} -y {NY} -g CF{NC}x6C{SGNAME}_{OCEAN_VERSION}{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} endif if ( {STEP2} == True ) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py index 16a8e821c..d552f7ae4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/make_bcs_latlon.py @@ -41,11 +41,9 @@ /bin/mv rst/Pfafstetter-M.rst rst/Pfafstetter.rst bin/CombineRasters.x -f 0 -t {NT} {DATENAME}{IMO}x{POLENAME}{JMO} Pfafstetter >/dev/null bin/CombineRasters.x -t {NT} DC{IM}xPC{JM} {DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter + bin/mk_runofftbl.x -g DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS 1 - if ( {SKIPLAND} != True ) then - bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} - bin/mk_runofftbl.x -g DC{IM}xPC{JM}_{DATENAME}{IMO}x{POLENAME}{JMO}-Pfafstetter - endif + if ( {SKIPLAND} != True ) bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} setenv OMP_NUM_THREADS {NCPUS} if ( {SKIPLAND} != True ) bin/mkCatchParam.x -x {NX} -y {NY} -g DE{IMO}xPE{JMO}_DE{IMO}xPE{JMO}-Pfafstetter -v {lbcsv} chmod 755 bin/create_README.csh diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index e9321635e..811c0b326 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -4,10 +4,11 @@ program mk_runofftbl ! ! !ARGUMENTS: ! -! Usage = "mk_runofftbl.x -g Gridname" +! Usage = "mk_runofftbl.x -g Gridname -v LBCSV" ! ! -g: Gridname: a string that describes the grids associated with the atmosphere and ocean model configuration ! eg, CF0180x6C_M6TP0072x0036-Pfafstetter +! -v: LBCSV : Land bcs version (F25, GM4, ICA, NL3, NL4, NL5, v06, v07, v08, v09, v10, v11, v12, ...) ! ! This program generates the runoff table *.trn and *.TRN files that are used in the Catchment model for ! directing runoff to its ocean sink. The inputs are (i) bcs geometry files associated with the Gridname @@ -32,7 +33,7 @@ program mk_runofftbl use mapl_hashmod use mapl_sortmod - use rmTinyCatchParaMod, only :: OUTLETV + use rmTinyCatchParaMod, only : init_bcs_config, OUTLETV use netcdf implicit none @@ -57,18 +58,12 @@ program mk_runofftbl integer :: nxt, command_argument_count character*(128) :: arg character*(128) :: Usage = "mk_runofftbl.x -g CF0180x6C_M6TP0072x0036-Pfafstetter -v v12" + character*5 :: LBCSV = 'UNDEF' character*1 :: opt ! ------------------------------------------------------------------ call get_environment_variable ("MAKE_BCS_INPUT_DIR",MAKE_BCS_INPUT_DIR) - - if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then - fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' - else - print *, "Routing files will not be produced with the selected land BCs version" - stop - endif ! Read inputs ----------------------------------------------------- @@ -96,6 +91,9 @@ program mk_runofftbl select case (opt) case ('g') Gridname = trim(arg) + case ('v') + LBCSV = trim(arg) + call init_bcs_config (trim(LBCSV)) ! get bcs details from version string case default print *, "Wrong flag -", opt print *, "Example usage with defaults: " @@ -106,8 +104,12 @@ program mk_runofftbl call get_command_argument(nxt,arg) end do - print *, " " - print*, "Working with input BCs grid: ", trim(Gridname) + if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then + fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' + else + print *, "Routing files will not be produced with the selected land BCs version" + stop + endif ! ------------------------------------------------------------------ From 4be7ffe4ee0b79433206faa7c2f58559823e40fb Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 3 Jul 2024 11:17:13 -0400 Subject: [PATCH 55/55] cleaned up and improved documentation of outlet locations version (mk_runofftbl.F90, rmTinyCatchParaMod.F90) --- .../Utils/Raster/makebcs/mk_runofftbl.F90 | 24 +++++++------------ .../Raster/makebcs/rmTinyCatchParaMod.F90 | 8 ++++++- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 index 811c0b326..88ed9210c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mk_runofftbl.F90 @@ -14,18 +14,12 @@ program mk_runofftbl ! directing runoff to its ocean sink. The inputs are (i) bcs geometry files associated with the Gridname ! and (ii) a binary file ("Outlet_latlon.43200x21600") that provides the land raster grid cells where the ! outlets are located. The latter file is either created by [..]/Raster/preproc/routing/run_routing_raster.py -! or from Randy's (Randal.d.koster@nasa.gov) old file under {MAKE_BCS_INPUT_DIR}/land/route/v1. +! or from Randy's (Randal.d.koster@nasa.gov) old file under {MAKE_BCS_INPUT_DIR}/land/route/v1. The version +! of the outlet file used by mk_runofftbl.x is determined via the LBCSV argument. ! The program first moves the outlet locations from the land raster grid cells to the nearest ocean pixels ! by calling outlets_to_ocean() and then generates the runoff table files. ! The subroutine outlets_to_ocean() currently works only for the MOM5 and MOM6 tripolar ocean grids. ! -!Basically based on bcs version we would use have these 3 options: -!======================================================= -!bcs version --> Outlet lat/lon file version -!--------------------------------------------------- -!v12 --> (new) v2 (produced with Yujin's pre-processing routines) -!v11 --> (old) v1 (produced with Randy's old file) -!otherwise --> N/A (do not run routing module of make_bcs) !========================================================= ! ! Yujin Zeng - June 17, 2024 @@ -104,11 +98,11 @@ program mk_runofftbl call get_command_argument(nxt,arg) end do - if(trim(OUTLETV)=="v1".or.trim(OUTLETV)=="v2")then - fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' + if (trim(OUTLETV)=="v1" .or. trim(OUTLETV)=="v2") then + fileLL=trim(MAKE_BCS_INPUT_DIR)//'/land/route/'//trim(OUTLETV)//'/Outlet_latlon.' else - print *, "Routing files will not be produced with the selected land BCs version" - stop + print *, "Routing files will not be produced with the selected land BCs version (too old)" + stop endif ! ------------------------------------------------------------------ @@ -730,9 +724,9 @@ subroutine read_oceanModel_mapl(res_MAPL,wetMask,nx,ny) ! read "mask" from netcdf file into "wetMask" - call check_ret(nf90_inq_varid(ncid,"mask",varid),subname) - call check_ret(nf90_get_var(ncid,varid,wetMask),subname) - call check_ret(nf90_close(ncid),subname) + call check_ret( nf90_inq_varid(ncid,"mask",varid), subname) + call check_ret( nf90_get_var( ncid,varid,wetMask), subname) + call check_ret( nf90_close( ncid), subname) end subroutine read_oceanModel_mapl diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 index ae912008b..d7867004d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/rmTinyCatchParaMod.F90 @@ -92,7 +92,13 @@ SUBROUTINE init_bcs_config (LBCSV) ! NGDC : Soil parameters from Reynolds et al. 2000, doi:10.1029/2000WR900130 (MERRA-2, Fortuna, Ganymed, Icarus) ! HWSD : Merged HWSDv1.21-STATSGO2 soil properties on 43200x21600 with Woesten et al. (1999) parameters ! HWSD_b : As in HWSD but with surgical fix of Argentina peatland issue (38S,60W) - + ! + ! OUTLETV: Definition of outlet locations. DEFAULT : N/A + ! N/A : No information (do not create routing "TRN" files). + ! v1 : Outlet locations file produced manually by Randy Koster. + ! v2 : Outlet locations file produced by run_routing_raster.py using routing information encoded + ! in SRTM-based Pfafstetter catchments and Greenland outlets info provided by Lauren Andrews. + implicit none character(*), intent (in) :: LBCSV ! land BCs version