#include "dims.h" ! subroutine rdmag(mytid) ! ! Read magnetic field data file: ! 2/00: new netcdf file was written from ~foster/tgcm/mkmag. ! S.a. comments in input_mod.f, and below. ! use input_module,only: tempdir,magvol implicit none #include "params.h" #include "cterp.h" #include "dynphi.h" ! ! Args: integer,intent(in) :: mytid ! under MPI if mytid > -1 ! ! Local: integer :: nwds,j,k,i,ii,ier character(len=80) :: dskfile,title ! ! Get and read magnetic data file. ! 2/00: using new netcdf mag file (see ~foster/tgcm/mkmag) ! 9/00: In new getms, if MPI, only master proc actually acquires mspath. ! call mkdiskflnm(magvol,dskfile) call getms(magvol,dskfile,tempdir,' ') call nc_rdmag(dskfile) ! call magdyn call dynpotmag end subroutine rdmag !------------------------------------------------------------------- subroutine dynpotmag use cons_module,only: kmaxp1 implicit none #include "params.h" #include "cterp.h" #include "dynphi.h" integer :: k,j C **** C **** TRANSFORM DYNPOT TO GEOMAGNETIC COORDINATES IN C **** PHIM3D(IMAXMP,JMAXM,-2:ZKMXP) C **** DO K = 1,KMAXP1 DO J = 1,JMAXM CALL GRDINT(PHIM3D(1,J,K),DYNPOT(1,0,K),IG,JG,WT,IMAXGP, 1 IMAXMP,IMAXG,JMAXG+2,IMAXM,JMAXM,J) ! 1 IMAXMP,IMAXG,JMAXG+2,IMAXM,JMAXM,J,0) ! iprint=0 for debug enddo enddo C **** C **** PERIODIC POINTS C **** DO K = 1,KMAXP1 DO J = 1,JMAXM PHIM3D(IMAXMP,J,K) = PHIM3D(1,J,K) enddo enddo end subroutine dynpotmag !------------------------------------------------------------------- subroutine nc_rdmag(dskfile) ! ! Read netcdf magnetic data file (mss /TGCM/data/magdat.nc) ! This file was written from the original cray-blocked file ! /ECRIDLEY/ECR90/ECRMG6 by code in ~foster/tgcm/mkmag) ! use netcdf_module,only: nc_open,nc_close,handle_ncerr implicit none #include "params.h" #include "fieldz.h" #include "cterp.h" #include "trig.h" #include "netcdf.inc" ! ! Args: character(len=*),intent(in) :: dskfile ! ! Local: integer,parameter :: zjmxp2=zjmx+2 integer :: istat,ncid integer :: ids1(1),ids2(2),ids3(3),ids4(4) integer :: id_zjmx,id_zimxp1,id_zjmxp2,id_dim2,id_dim3, | id_imaxmp,id_jmaxm,id_dim4 integer :: idv_alatm,idv_alonm,idv_xb,idv_yb,idv_zb,idv_bmod, | idv_dmlat,idv_rjac,idv_av,idv_p,idv_rmag11,idv_rmagc,idv_rmag2, | idv_rmag22,idv_rjacd,idv_im,idv_jm integer :: idv_ig,idv_jg,idv_wt,idv_dim,idv_djm integer :: idv_cslatm,idv_snlatm,idv_cslonm,idv_snlonm,idv_cslatg, | idv_snlatg,idv_cslong,idv_snlong integer :: start_1d(1),count_1d(1),start_2d(2),count_2d(2), | start_3d(3),count_3d(3),start_4d(4),count_4d(4) character(len=8) :: dimname real :: fmin,fmax ! write(6,"(/,72('-'))") write(6,"('RDMAG: read magnetic field data file:')") ! ! Open the netcdf dataset: call nc_open(ncid,dskfile,'OLD','READ') if (ncid <= 0) then write(6,"(/,'>>> nc_rdmag: error opening netcdf mag data ', | 'file ',a)") trim(dskfile) stop 'nc_rdmag' ! else ! write(6,"('nc_rdmag: opened netcdf mag data file ',a, ! | ' ncid=',i8)") trim(dskfile),ncid endif ! ! Check dimensions: call checkdim(ncid,"zjmx" ,zjmx) call checkdim(ncid,"zimxp1" ,zimxp1) call checkdim(ncid,"zjmxp2" ,zjmxp1+1) call checkdim(ncid,"imaxmp" ,imaxmp) call checkdim(ncid,"jmaxm" ,jmaxm) ! ! Read variables for fieldz.h: ! 2-d doubles (zimxp1,0:zjmxp1): start_2d(:) = 1 count_2d(1) = zimxp1 count_2d(2) = zjmxp2 call rd2dfld(ncid,'ALATM ',idv_alatm ,start_2d,count_2d,alatm ) call rd2dfld(ncid,'ALONM ',idv_alonm ,start_2d,count_2d,alonm ) call rd2dfld(ncid,'XB ',idv_xb ,start_2d,count_2d,xb ) call rd2dfld(ncid,'YB ',idv_yb ,start_2d,count_2d,yb ) call rd2dfld(ncid,'ZB ',idv_zb ,start_2d,count_2d,zzb ) call rd2dfld(ncid,'BMOD ',idv_bmod ,start_2d,count_2d,bmod ) call rd2dfld(ncid,'DMLAT ',idv_dmlat ,start_2d,count_2d,dmlat ) call rd2dfld(ncid,'P ',idv_p ,start_2d,count_2d,p ) call rd2dfld(ncid,'RMAG11',idv_rmag11,start_2d,count_2d,rmag11) call rd2dfld(ncid,'RMAGC ',idv_rmagc ,start_2d,count_2d,rmagc ) call rd2dfld(ncid,'RMAG2 ',idv_rmag2 ,start_2d,count_2d,rmag2 ) call rd2dfld(ncid,'RMAG22',idv_rmag22,start_2d,count_2d,rmag22) call rd2dfld(ncid,'RJACD ',idv_rjacd ,start_2d,count_2d,rjacd ) ! ! RJAC(zimxp1,0:zjmxp1,2,2): start_4d(:) = 1 count_4d(1) = zimxp1 count_4d(2) = zjmxp2 count_4d(3:4) = 2 istat = nf_inq_varid(ncid,'RJAC',idv_rjac) istat = nf_get_vara_double(ncid,idv_rjac,start_4d,count_4d,rjac) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for rjac') call fminmax(rjac,zimxp1*zjmxp2*2*2,fmin,fmax) write(6,"(' RJAC min,max=',2e12.4)") fmin,fmax ! ! AV(zimxp1,0:zjmxp1,3,2): start_4d(:) = 1 count_4d(1) = zimxp1 count_4d(2) = zjmxp2 count_4d(3) = 3 count_4d(4) = 2 istat = nf_inq_varid(ncid,'AV',idv_av) istat = nf_get_vara_double(ncid,idv_av,start_4d,count_4d,av) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for av') call fminmax(av,zimxp1*zjmxp2*3*2,fmin,fmax) write(6,"(' AV min,max=',2e12.4)") fmin,fmax ! ! Read variables into cterp.h: ! ! Integers in /terp_int/ (cterp.h): ! IG(imaxmp,jmaxm) start_2d(:) = 1 count_2d(1) = imaxmp count_2d(2) = jmaxm istat = nf_inq_varid(ncid,'IG',idv_ig) istat = nf_get_vara_int(ncid,idv_ig,start_2d,count_2d,ig) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_int for ig') ! ! JG(imaxmp,jmaxm) count_2d(1) = imaxmp count_2d(2) = jmaxm istat = nf_inq_varid(ncid,'JG',idv_jg) istat = nf_get_vara_int(ncid,idv_jg,start_2d,count_2d,jg) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_int for jg') ! ! IM(zimxp1,0:zjmxp1): count_2d(1) = zimxp1 count_2d(2) = zjmxp2 istat = nf_inq_varid(ncid,'IM',idv_im) istat = nf_get_vara_int(ncid,idv_im,start_2d,count_2d,im) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_int for im') ! ! JM(zimxp1,0:zjmxp1): istat = nf_inq_varid(ncid,'JM',idv_jm) istat = nf_get_vara_int(ncid,idv_jm,start_2d,count_2d,jm) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_int for jm') ! ! Reals in /terp_real/ (cterp.h): ! WT(4,imaxmp,jmaxm): start_3d(:) = 1 count_3d(1) = 4 count_3d(2) = imaxmp count_3d(3) = jmaxm istat = nf_inq_varid(ncid,'WT',idv_wt) istat = nf_get_vara_double(ncid,idv_wt,start_3d,count_3d,wt) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for wt') call fminmax(wt,4*imaxmp*jmaxm,fmin,fmax) write(6,"(' WT min,max=',2e12.4)") fmin,fmax ! ! DIM and DJM(zimxp1,0:zjmxp1): start_2d(:) = 1 count_2d(1) = zimxp1 count_2d(2) = zjmxp2 call rd2dfld(ncid,'DIM ',idv_dim ,start_2d,count_2d,dim ) call rd2dfld(ncid,'DJM ',idv_djm ,start_2d,count_2d,djm ) ! ! Read variables into /TRIG/ (trig.h): ! start_2d(:) = 1 count_2d(1) = zimxp1 count_2d(2) = zjmx call rd2dfld(ncid,'CSLATM ',idv_cslatm ,start_2d,count_2d,cslatm) call rd2dfld(ncid,'SNLATM ',idv_snlatm ,start_2d,count_2d,snlatm) call rd2dfld(ncid,'CSLONM ',idv_cslonm ,start_2d,count_2d,cslonm) call rd2dfld(ncid,'SNLONM ',idv_snlonm ,start_2d,count_2d,snlonm) ! ! CSLATG(zjmx): start_1d(:) = 1 count_1d(1) = zjmx istat = nf_inq_varid(ncid,'CSLATG',idv_cslatg) istat = nf_get_vara_double(ncid,idv_cslatg,start_1d,count_1d, | cslatg) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for cslatg') call fminmax(cslatg,zjmx,fmin,fmax) write(6,"(' CSLATG min,max=',2e12.4)") fmin,fmax ! ! SNLATG(zjmx): istat = nf_inq_varid(ncid,'SNLATG',idv_snlatg) istat = nf_get_vara_double(ncid,idv_snlatg,start_1d,count_1d, | snlatg) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for snlatg') call fminmax(snlatg,zjmx,fmin,fmax) write(6,"(' SNLATG min,max=',2e12.4)") fmin,fmax ! ! CSLONG(zimxp1): count_1d(1) = zimxp1 istat = nf_inq_varid(ncid,'CSLONG',idv_cslong) istat = nf_get_vara_double(ncid,idv_cslong,start_1d,count_1d, | cslong) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for cslong') call fminmax(cslong,zimxp1,fmin,fmax) write(6,"(' CSLONG min,max=',2e12.4)") fmin,fmax ! ! SNLONG(zimxp1): istat = nf_inq_varid(ncid,'SNLONG',idv_snlong) istat = nf_get_vara_double(ncid,idv_cslong,start_1d,count_1d, | snlong) if (istat /= NF_NOERR) call handle_ncerr(istat, | 'Error return from nf_get_vara_double for snlong') call fminmax(snlong,zimxp1,fmin,fmax) write(6,"(' SNLONG min,max=',2e12.4)") fmin,fmax ! ! Close the dataset: call nc_close(ncid) write(6,"('Completed read of magnetic field data file.')") write(6,"(72('-'),/)") end subroutine nc_rdmag !------------------------------------------------------------------- subroutine checkdim(ncid,dimname,iparam) ! ! Get length of dimension "dimname". If this length is not equal ! to iparam, stop with error message. ! use netcdf_module,only: handle_ncerr implicit none #include "netcdf.inc" ! ! Args: integer,intent(in) :: ncid,iparam character(len=*),intent(in) :: dimname ! ! Local: integer :: istat,iddim,len character(len=80) :: char80 ! ! Get dim id: istat = nf_inq_dimid(ncid,dimname,iddim) if (istat /= NF_NOERR) then write(char80,"('nc_rdmag: error getting dim id for ', | a)") dimname call handle_ncerr(istat,char80) endif ! ! Get dim length: istat = nf_inq_dimlen(ncid,iddim,len) if (istat /= NF_NOERR) then write(char80,"('nc_rdmag: error getting length of ', | 'dimension ',a)") dimname call handle_ncerr(istat,char80) endif ! ! Compare with iparam: if (len /= iparam) then write(6,"(/,'>>> nc_rdmag: unexpected length for ', | 'dimension ',a)") dimname write(6,"(' length read = ',i3,' should be = ',i3)") | len,iparam stop 'nc_rdmag' endif end subroutine checkdim !------------------------------------------------------------------- subroutine rd2dfld(ncid,name,idvout,start_2d,count_2d,var) use netcdf_module,only: handle_ncerr implicit none #include "netcdf.inc" ! ! Read 2-d double array from ncid to var: ! ! Args: integer,intent(in) :: ncid,start_2d(2),count_2d(2) character(len=*),intent(in) :: name integer,intent(out) :: idvout real,intent(out) :: var(count_2d(1),count_2d(2)) ! ! Local: integer :: istat character(len=80) :: char80 real :: fmin,fmax ! istat = nf_inq_varid(ncid,name,idvout) istat = nf_get_vara_double(ncid,idvout,start_2d,count_2d,var) write(char80,"('Error return from nf_get_vara_double for var', | a)") name if (istat /= NF_NOERR) call handle_ncerr(istat,char80) ! call fminmax(var,count_2d(1)*count_2d(2),fmin,fmax) ! write(6,"('rd2dfld: ',a,' fmin,max=',2e12.4)") name,fmin,fmax end subroutine rd2dfld