SUBROUTINE inp_par (model) ! !svn $Id: inp_par.F 412 2009-12-03 20:46:03Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2009 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This routine reads in input model parameters from standard input. ! ! It also writes out these parameters to standard output. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_iounits USE mod_ncparam USE mod_scalars USE mod_strings ! USE distribute_mod, ONLY : mp_bcasti, mp_bcasts USE ran_state, ONLY: ran_seed ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: model ! ! Local variable declarations. ! logical :: Lwrite integer :: Itile, Jtile, Nghost, Ntiles, tile integer :: Imin, Imax, Jmin, Jmax integer :: MaxHaloLenI, MaxHaloLenJ integer :: inp, out, itrc, ng, npts, sequence real(r8) :: cff real(r8), parameter :: spv = 0.0_r8 ! !----------------------------------------------------------------------- ! Read in and report input model parameters. !----------------------------------------------------------------------- ! ! Set input units. ! Lwrite=Master inp=1 out=stdout ! ! Get current data. ! IF (Master) CALL get_date (date_str) DO ng=1,Ngrids CALL mp_bcasts (ng, model, date_str) END DO ! !----------------------------------------------------------------------- ! Read in physical model input parameters. !----------------------------------------------------------------------- ! IF (Lwrite) WRITE (out,10) version, TRIM(date_str) 10 FORMAT (/,' Model Input Parameters: ROMS/TOMS version ',a,/, & & 26x,a,/,1x,77('-')) ! ! In distributed-memory configurations, the input physical parameters ! script is opened as a regular file. It is read and processed by all ! parallel nodes. This is to avoid a very complex broadcasting of the ! input parameters to all nodes. ! IF (Master) CALL my_getarg (1,Iname) DO ng=1,Ngrids CALL mp_bcasts (ng, model, Iname) END DO OPEN (inp, FILE=TRIM(Iname), FORM='formatted', STATUS='old', & & ERR=20) GO TO 40 20 IF (Master) WRITE (stdout,30) exit_flag=2 RETURN 30 FORMAT (/,' INP_PAR - Unable to open ROMS/TOMS input script ', & & 'file.', & & /,11x,'In distributed-memory applications, the input', & & /,11x,'script file is processed in parallel. The Unix', & & /,11x,'routine GETARG is used to get script file name.', & & /,11x,'For example, in MPI applications make sure that', & & /,11x,'command line is something like:',/, & & /,11x,'mpirun -np 4 ocean ocean.in',/,/,11x,'and not',/, & & /,11x,'mpirun -np 4 ocean < ocean.in',/) 40 CONTINUE CALL read_PhyPar (model, inp, out, Lwrite) CALL mp_bcasti (1, model, exit_flag) IF (exit_flag.ne.NoError) RETURN ! !----------------------------------------------------------------------- ! Set lower and upper bounds indices per domain partition for all ! nested grids. !----------------------------------------------------------------------- ! ! Allocate structure. ! IF (.not.allocated(BOUNDS)) THEN allocate ( BOUNDS(Ngrids) ) DO ng=1,Ngrids Ntiles=NtileI(ng)*NtileJ(ng)-1 allocate ( BOUNDS(ng) % tile (-1:Ntiles) ) allocate ( BOUNDS(ng) % LBi (-1:Ntiles) ) allocate ( BOUNDS(ng) % UBi (-1:Ntiles) ) allocate ( BOUNDS(ng) % LBj (-1:Ntiles) ) allocate ( BOUNDS(ng) % UBj (-1:Ntiles) ) allocate ( BOUNDS(ng) % Iend (-1:Ntiles) ) allocate ( BOUNDS(ng) % Istr (-1:Ntiles) ) allocate ( BOUNDS(ng) % Jstr (-1:Ntiles) ) allocate ( BOUNDS(ng) % Jend (-1:Ntiles) ) allocate ( BOUNDS(ng) % IstrR(-1:Ntiles) ) allocate ( BOUNDS(ng) % IstrT(-1:Ntiles) ) allocate ( BOUNDS(ng) % IstrU(-1:Ntiles) ) allocate ( BOUNDS(ng) % IendR(-1:Ntiles) ) allocate ( BOUNDS(ng) % IendT(-1:Ntiles) ) allocate ( BOUNDS(ng) % JstrR(-1:Ntiles) ) allocate ( BOUNDS(ng) % JstrT(-1:Ntiles) ) allocate ( BOUNDS(ng) % JstrV(-1:Ntiles) ) allocate ( BOUNDS(ng) % JendR(-1:Ntiles) ) allocate ( BOUNDS(ng) % JendT(-1:Ntiles) ) allocate ( BOUNDS(ng) % Imin (4,0:1,0:Ntiles) ) allocate ( BOUNDS(ng) % Imax (4,0:1,0:Ntiles) ) allocate ( BOUNDS(ng) % Jmin (4,0:1,0:Ntiles) ) allocate ( BOUNDS(ng) % Jmax (4,0:1,0:Ntiles) ) END DO END IF ! ! Set boundary edge I- or J-indices for each variable type. ! DO ng=1,Ngrids BOUNDS(ng) % edge(iwest ,p2dvar) = 1 BOUNDS(ng) % edge(iwest ,r2dvar) = 0 BOUNDS(ng) % edge(iwest ,u2dvar) = 1 BOUNDS(ng) % edge(iwest ,v2dvar) = 0 BOUNDS(ng) % edge(ieast ,p2dvar) = Lm(ng)+1 BOUNDS(ng) % edge(ieast ,r2dvar) = Lm(ng)+1 BOUNDS(ng) % edge(ieast ,u2dvar) = Lm(ng)+1 BOUNDS(ng) % edge(ieast ,v2dvar) = Lm(ng)+1 BOUNDS(ng) % edge(isouth,p2dvar) = 1 BOUNDS(ng) % edge(isouth,u2dvar) = 0 BOUNDS(ng) % edge(isouth,r2dvar) = 0 BOUNDS(ng) % edge(isouth,v2dvar) = 1 BOUNDS(ng) % edge(inorth,p2dvar) = Mm(ng)+1 BOUNDS(ng) % edge(inorth,r2dvar) = Mm(ng)+1 BOUNDS(ng) % edge(inorth,u2dvar) = Mm(ng)+1 BOUNDS(ng) % edge(inorth,v2dvar) = Mm(ng)+1 END DO ! ! Set tile computational indices and arrays allocation bounds. ! Nghost=3 DO ng=1,Ngrids BOUNDS(ng) % LBij = 0 BOUNDS(ng) % UBij = MAX(Lm(ng)+1,Mm(ng)+1) DO tile=-1,NtileI(ng)*NtileJ(ng)-1 BOUNDS(ng) % tile(tile) = tile CALL get_tile (ng, tile, Itile, Jtile, & & BOUNDS(ng) % Istr(tile), & & BOUNDS(ng) % Iend(tile), & & BOUNDS(ng) % Jstr(tile), & & BOUNDS(ng) % Jend(tile), & & BOUNDS(ng) % IstrR(tile), & & BOUNDS(ng) % IstrT(tile), & & BOUNDS(ng) % IstrU(tile), & & BOUNDS(ng) % IendR(tile), & & BOUNDS(ng) % IendT(tile), & & BOUNDS(ng) % JstrR(tile), & & BOUNDS(ng) % JstrT(tile), & & BOUNDS(ng) % JstrV(tile), & & BOUNDS(ng) % JendR(tile), & & BOUNDS(ng) % JendT(tile)) CALL get_bounds (ng, tile, 0, Nghost, Itile, Jtile, & & BOUNDS(ng) % LBi(tile), & & BOUNDS(ng) % UBi(tile), & & BOUNDS(ng) % LBj(tile), & & BOUNDS(ng) % UBj(tile)) END DO END DO ! ! Set I/O processing minimum (Imin, Jmax) and maximum (Imax, Jmax) ! indices for non-overlapping (Nghost=0) and overlapping (Nghost>0) ! tiles for each C-grid type variable. ! Nghost=3 DO ng=1,Ngrids DO tile=0,NtileI(ng)*NtileJ(ng)-1 CALL get_bounds (ng, tile, p2dvar, 0 , Itile, Jtile, & & BOUNDS(ng) % Imin(1,0,tile), & & BOUNDS(ng) % Imax(1,0,tile), & & BOUNDS(ng) % Jmin(1,0,tile), & & BOUNDS(ng) % Jmax(1,0,tile)) CALL get_bounds (ng, tile, p2dvar, Nghost, Itile, Jtile, & & BOUNDS(ng) % Imin(1,1,tile), & & BOUNDS(ng) % Imax(1,1,tile), & & BOUNDS(ng) % Jmin(1,1,tile), & & BOUNDS(ng) % Jmax(1,1,tile)) CALL get_bounds (ng, tile, r2dvar, 0 , Itile, Jtile, & & BOUNDS(ng) % Imin(2,0,tile), & & BOUNDS(ng) % Imax(2,0,tile), & & BOUNDS(ng) % Jmin(2,0,tile), & & BOUNDS(ng) % Jmax(2,0,tile)) CALL get_bounds (ng, tile, r2dvar, Nghost, Itile, Jtile, & & BOUNDS(ng) % Imin(2,1,tile), & & BOUNDS(ng) % Imax(2,1,tile), & & BOUNDS(ng) % Jmin(2,1,tile), & & BOUNDS(ng) % Jmax(2,1,tile)) CALL get_bounds (ng, tile, u2dvar, 0 , Itile, Jtile, & & BOUNDS(ng) % Imin(3,0,tile), & & BOUNDS(ng) % Imax(3,0,tile), & & BOUNDS(ng) % Jmin(3,0,tile), & & BOUNDS(ng) % Jmax(3,0,tile)) CALL get_bounds (ng, tile, u2dvar, Nghost, Itile, Jtile, & & BOUNDS(ng) % Imin(3,1,tile), & & BOUNDS(ng) % Imax(3,1,tile), & & BOUNDS(ng) % Jmin(3,1,tile), & & BOUNDS(ng) % Jmax(3,1,tile)) CALL get_bounds (ng, tile, v2dvar, 0 , Itile, Jtile, & & BOUNDS(ng) % Imin(4,0,tile), & & BOUNDS(ng) % Imax(4,0,tile), & & BOUNDS(ng) % Jmin(4,0,tile), & & BOUNDS(ng) % Jmax(4,0,tile)) CALL get_bounds (ng, tile, v2dvar, Nghost, Itile, Jtile, & & BOUNDS(ng) % Imin(4,1,tile), & & BOUNDS(ng) % Imax(4,1,tile), & & BOUNDS(ng) % Jmin(4,1,tile), & & BOUNDS(ng) % Jmax(4,1,tile)) END DO END DO ! ! Set NetCDF IO bounds. ! DO ng=1,Ngrids CALL get_iobounds (ng) END DO ! !----------------------------------------------------------------------- ! Check tile partition starting and ending (I,J) indices for illegal ! domain decomposition parameters NtileI and NtileJ in standard input ! file. !----------------------------------------------------------------------- ! IF (Master) THEN DO ng=1,Ngrids WRITE (stdout,50) ng, Lm(ng), Mm(ng), N(ng), & & NtileI(ng), NtileJ(ng) DO tile=0,NtileI(ng)*NtileJ(ng)-1 npts=(BOUNDS(ng)%Iend(tile)- & & BOUNDS(ng)%Istr(tile)+1)* & & (BOUNDS(ng)%Jend(tile)- & & BOUNDS(ng)%Jstr(tile)+1)*N(ng) WRITE (stdout,70) tile, & & BOUNDS(ng)%Istr(tile), & & BOUNDS(ng)%Iend(tile), & & BOUNDS(ng)%Jstr(tile), & & BOUNDS(ng)%Jend(tile), & & npts IF ((BOUNDS(ng)%Iend(tile)- & & BOUNDS(ng)%Istr(tile)+1).lt.2) THEN WRITE (stdout,80) ng, 'NtileI = ', NtileI(ng), & & 'Lm = ', Lm(ng), & & 'Istr = ', BOUNDS(ng)%Istr(tile), & & ' Iend = ', BOUNDS(ng)%Iend(tile), & & 'NtileI' exit_flag=6 RETURN END IF IF ((BOUNDS(ng)%Jend(tile)- & & BOUNDS(ng)%Jstr(tile)+1).lt.2) THEN WRITE (stdout,80) ng, 'NtileJ = ', NtileJ(ng), & & 'Mm = ', Mm(ng), & & 'Jstr = ', BOUNDS(ng)%Jstr(tile), & & ' Jend = ', BOUNDS(ng)%Jend(tile), & & 'NtileJ' exit_flag=6 RETURN END IF END DO END DO 50 FORMAT (/,' Tile partition information for Grid ',i2.2,':',2x, & & i4.4,'x',i4.4,'x',i4.4,2x,'tiling: ',i3.3,'x',i3.3,/,/, & & 5x,'tile',5x,'Istr',5x,'Iend',5x,'Jstr',5x,'Jend', & & 5x,'Npts',/) 70 FORMAT (5(5x,i4),2x,i7) 80 FORMAT (/,' INP_PAR - domain decomposition error in input ', & & 'script file for grid: ',i2,/, & & /,11x,'The domain partition parameter, ',a,i3, & & /,11x,'is incompatible with grid size, ',a,i4, & & /,11x,'because it yields too small tile, ',a,i3,a,i3, & & /,11x,'Decrease partition parameter: ',a) END IF CALL mp_bcasti (1, model, exit_flag) IF (exit_flag.ne.NoError) RETURN ! ! Report tile minimum and maximum fractional grid coordinates. ! DO ng=1,Ngrids IF (Master) THEN WRITE (stdout,90) DO tile=0,NtileI(ng)*NtileJ(ng)-1 WRITE (stdout,100) tile, & & DOMAIN(ng)%Xmin_rho(tile), & & DOMAIN(ng)%Xmax_rho(tile), & & DOMAIN(ng)%Ymin_rho(tile), & & DOMAIN(ng)%Ymax_rho(tile), 'RHO-points' END DO WRITE (stdout,'(1x)') DO tile=0,NtileI(ng)*NtileJ(ng)-1 WRITE (stdout,100) tile, & & DOMAIN(ng)%Xmin_u(tile), & & DOMAIN(ng)%Xmax_u(tile), & & DOMAIN(ng)%Ymin_u(tile), & & DOMAIN(ng)%Ymax_u(tile), ' U-points' END DO WRITE (stdout,'(1x)') DO tile=0,NtileI(ng)*NtileJ(ng)-1 WRITE (stdout,100) tile, & & DOMAIN(ng)%Xmin_v(tile), & & DOMAIN(ng)%Xmax_v(tile), & & DOMAIN(ng)%Ymin_v(tile), & & DOMAIN(ng)%Ymax_v(tile), ' V-points' END DO 90 FORMAT (/,' Tile minimum and maximum fractional grid ', & & 'coordinates:',/, & & ' (interior points only)',/,/, & & 5x,'tile',5x,'Xmin',5x,'Xmax',5x,'Ymin',5x,'Ymax', & & 5x,'grid',/) 100 FORMAT (5x,i4,4f9.2,2x,a) END IF END DO ! !----------------------------------------------------------------------- ! Determine the maximum tile lengths in XI and ETA directions for ! distributed-memory communications. Notice that halo size are ! increased by few points to allow exchanging of private arrays. !----------------------------------------------------------------------- ! Nghost=3 DO ng=1,Ngrids MaxHaloLenI=0 MaxHaloLenJ=0 DO tile=0,NtileI(ng)*NtileJ(ng)-1 Imin=BOUNDS(ng)%LBi(tile)-1 Imax=BOUNDS(ng)%UBi(tile)+1 Jmin=BOUNDS(ng)%LBj(tile)-1 Jmax=BOUNDS(ng)%UBj(tile)+1 MaxHaloLenI=MAX(MaxHaloLenI,(Imax-Imin+1)) MaxHaloLenJ=MAX(MaxHaloLenJ,(Jmax-Jmin+1)) END DO HaloSizeI(ng)=Nghost*MaxHaloLenI+6*Nghost HaloSizeJ(ng)=Nghost*MaxHaloLenJ+6*Nghost TileSide(ng)=MAX(MaxHaloLenI,MaxHaloLenJ) TileSize(ng)=MaxHaloLenI*MaxHaloLenJ IF (Master) THEN WRITE (stdout,110) ng, HaloSizeI(ng), ng, HaloSizeJ(ng), & & ng, TileSide(ng), ng, TileSize(ng) 110 FORMAT (/,' Maximum halo size in XI and ETA directions:',/, & & /,' HaloSizeI(',i1,') = ',i7, & & /,' HaloSizeJ(',i1,') = ',i7, & & /,' TileSide(',i1,') = ',i7, & & /,' TileSize(',i1,') = ',i7,/) END IF END DO ! !----------------------------------------------------------------------- ! Read in sediment model input parameters. !----------------------------------------------------------------------- ! OPEN (25, FILE=TRIM(sparnam), FORM='formatted', STATUS='old') CALL read_SedPar (model, 25, out, Lwrite) ! !----------------------------------------------------------------------- ! Read in floats input parameters. !----------------------------------------------------------------------- ! OPEN (45, FILE=TRIM(fposnam), FORM='formatted', STATUS='old') CALL read_FloatsPar (model, 45, out, Lwrite) ! !----------------------------------------------------------------------- ! Check C-preprocessing options and definitions. !----------------------------------------------------------------------- ! IF (Master) THEN CALL checkdefs CALL my_flush (out) END IF CALL mp_bcasti (1, model, exit_flag) CALL mp_bcasts (1, model, Coptions) IF (exit_flag.ne.NoError) RETURN ! !----------------------------------------------------------------------- ! Compute various constants. !----------------------------------------------------------------------- ! gorho0=g/rho0 DO ng=1,Ngrids dtfast(ng)=dt(ng)/REAL(ndtfast(ng),r8) ! ! Take the square root of the biharmonic coefficients so it can ! be applied to each harmonic operator. ! nl_visc4(ng)=SQRT(ABS(nl_visc4(ng))) tkenu4(ng)=SQRT(ABS(tkenu4(ng))) ! ! Compute inverse nudging coefficients (1/s) used in various tasks. ! IF (Znudg(ng).gt.0.0_r8) THEN Znudg(ng)=1.0_r8/(Znudg(ng)*86400.0_r8) ELSE Znudg(ng)=0.0_r8 END IF IF (M2nudg(ng).gt.0.0_r8) THEN M2nudg(ng)=1.0_r8/(M2nudg(ng)*86400.0_r8) ELSE M2nudg(ng)=0.0_r8 END IF IF (M3nudg(ng).gt.0.0_r8) THEN M3nudg(ng)=1.0_r8/(M3nudg(ng)*86400.0_r8) ELSE M3nudg(ng)=0.0_r8 END IF ! ! Convert momentum stresses and tracer flux scales to kinematic ! Values. Recall, that all the model fluxes are kinematic. ! cff=1.0_r8/rho0 Fscale(idUsms,ng)=cff*Fscale(idUsms,ng) Fscale(idVsms,ng)=cff*Fscale(idVsms,ng) Fscale(idUbms,ng)=cff*Fscale(idUbms,ng) Fscale(idVbms,ng)=cff*Fscale(idVbms,ng) Fscale(idUbrs,ng)=cff*Fscale(idUbrs,ng) Fscale(idVbrs,ng)=cff*Fscale(idVbrs,ng) Fscale(idUbws,ng)=cff*Fscale(idUbws,ng) Fscale(idVbws,ng)=cff*Fscale(idVbws,ng) Fscale(idUbcs,ng)=cff*Fscale(idUbcs,ng) Fscale(idVbcs,ng)=cff*Fscale(idVbcs,ng) cff=1.0_r8/(rho0*Cp) Fscale(idTsur(itemp),ng)=cff*Fscale(idTsur(itemp),ng) Fscale(idTbot(itemp),ng)=cff*Fscale(idTbot(itemp),ng) Fscale(idSrad,ng)=cff*Fscale(idSrad,ng) Fscale(idLdwn,ng)=cff*Fscale(idLdwn,ng) Fscale(idLrad,ng)=cff*Fscale(idLrad,ng) Fscale(idLhea,ng)=cff*Fscale(idLhea,ng) Fscale(idShea,ng)=cff*Fscale(idShea,ng) Fscale(iddQdT,ng)=cff*Fscale(iddQdT,ng) END DO ! !----------------------------------------------------------------------- ! Initialize random number sequence so we can get identical results ! everytime that we run the same solution. !----------------------------------------------------------------------- ! sequence=759 CALL ran_seed (sequence) RETURN END SUBROUTINE inp_par SUBROUTINE read_SedPar (model, inp, out, Lwrite) ! !======================================================================= ! ! ! This routine reads in cohesive and non-cohesive sediment model ! ! parameters. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_ncparam USE mod_scalars USE mod_sediment ! implicit none ! ! Imported variable declarations ! logical, intent(in) :: Lwrite integer, intent(in) :: model, inp, out ! ! Local variable declarations. ! integer :: Npts, Nval, i, ng, itrc, status integer :: decode_line, load_i, load_l, load_r logical, dimension(Ngrids) :: Lbed logical, dimension(MBOTP,Ngrids) :: Lbottom logical, dimension(NCS,Ngrids) :: Lmud logical, dimension(NNS,Ngrids) :: Lsand real(r8), dimension(Ngrids) :: Rbed real(r8), dimension(NCS,Ngrids) :: Rmud real(r8), dimension(NNS,Ngrids) :: Rsand real(r8), dimension(100) :: Rval character (len=40) :: KeyWord character (len=160) :: line character (len=160), dimension(100) :: Cval ! !----------------------------------------------------------------------- ! Read in cohesive and non-cohesive model parameters. !----------------------------------------------------------------------- ! DO WHILE (.TRUE.) READ (inp,'(a)',ERR=10,END=20) line status=decode_line(line, KeyWord, Nval, Cval, Rval) IF (status.gt.0) THEN IF (TRIM(KeyWord).eq.'Lsediment') THEN Npts=load_l(Nval, Cval, Ngrids, Lsediment) ELSE IF (TRIM(KeyWord).eq.'NEWLAYER_THICK') THEN Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids newlayer_thick(ng)=Rbed(ng) END DO ELSE IF (TRIM(KeyWord).eq.'MINLAYER_THICK') THEN Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids minlayer_thick(ng)=Rbed(ng) END DO ELSE IF (TRIM(KeyWord).eq.'BEDLOAD_COEFF') THEN Npts=load_r(Nval, Rval, Ngrids, Rbed) DO ng=1,Ngrids bedload_coeff(ng)=Rbed(ng) END DO ELSE IF (TRIM(KeyWord).eq.'MUD_SD50') THEN IF (.not.allocated(Sd50)) allocate (Sd50(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS Sd50(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_CSED') THEN IF (.not.allocated(Csed)) allocate (Csed(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud ) DO ng=1,Ngrids DO itrc=1,NCS Csed(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_SRHO') THEN IF (.not.allocated(Srho)) allocate (Srho(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS Srho(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_WSED') THEN IF (.not.allocated(Wsed)) allocate (Wsed(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS Wsed(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_ERATE') THEN IF (.not.allocated(Erate)) allocate (Erate(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS Erate(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_TAU_CE') THEN IF (.not.allocated(tau_ce)) allocate (tau_ce(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS tau_ce(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_TAU_CD') THEN IF (.not.allocated(tau_cd)) allocate (tau_cd(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS tau_cd(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_POROS') THEN IF (.not.allocated(poros)) allocate (poros(NST,Ngrids)) Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS poros(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_TNU2') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) nl_tnu2(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_TNU4') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) nl_tnu4(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_MUD_TNU2') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) ad_tnu2(i,ng)=Rmud(itrc,ng) tl_tnu2(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_MUD_TNU4') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) ad_tnu4(i,ng)=Rmud(itrc,ng) nl_tnu4(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_AKT_BAK') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) Akt_bak(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_AKT_fac') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) ad_Akt_fac(i,ng)=Rmud(itrc,ng) tl_Akt_fac(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_TNUDG') THEN Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) Tnudg(i,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_MORPH_FAC') THEN IF (.not.allocated(morph_fac)) THEN allocate (morph_fac(NST,Ngrids)) END IF Npts=load_r(Nval, Rval, NCS*Ngrids, Rmud) DO ng=1,Ngrids DO itrc=1,NCS morph_fac(itrc,ng)=Rmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'MUD_Ltracer') THEN Npts=load_l(Nval, Cval, NCS*Ngrids, Lmud) DO ng=1,Ngrids DO itrc=1,NCS i=idsed(itrc) LtracerSrc(i,ng)=Lmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idmud)') THEN Npts=load_l(Nval, Cval, NCS*Ngrids, Lmud) DO ng=1,Ngrids DO itrc=1,NCS i=idTvar(idsed(itrc)) Hout(i,ng)=Lmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(iMfrac)') THEN Npts=load_l(Nval, Cval, NCS*Ngrids, Lmud) DO ng=1,Ngrids DO itrc=1,NCS i=idfrac(itrc) Hout(i,ng)=Lmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(iMmass)') THEN Npts=load_l(Nval, Cval, NCS*Ngrids, Lmud) DO ng=1,Ngrids DO itrc=1,NCS i=idBmas(itrc) Hout(i,ng)=Lmud(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_SD50') THEN IF (.not.allocated(Sd50)) allocate (Sd50(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc Sd50(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_CSED') THEN IF (.not.allocated(Csed)) allocate (Csed(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand ) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc Csed(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_SRHO') THEN IF (.not.allocated(Srho)) allocate (Srho(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc Srho(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_WSED') THEN IF (.not.allocated(Wsed)) allocate (Wsed(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc Wsed(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_ERATE') THEN IF (.not.allocated(Erate)) allocate (Erate(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc Erate(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_TAU_CE') THEN IF (.not.allocated(tau_ce)) allocate (tau_ce(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc tau_ce(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_TAU_CD') THEN IF (.not.allocated(tau_cd)) allocate (tau_cd(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc tau_cd(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_POROS') THEN IF (.not.allocated(poros)) allocate (poros(NST,Ngrids)) Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc poros(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_TNU2') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) nl_tnu2(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_TNU4') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) nl_tnu4(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_SAND_TNU2') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) ad_tnu2(i,ng)=Rsand(itrc,ng) tl_tnu2(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_SAND_TNU4') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) ad_tnu4(i,ng)=Rsand(itrc,ng) tl_tnu4(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_AKT_BAK') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) Akt_bak(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_AKT_fac') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) ad_Akt_fac(i,ng)=Rsand(itrc,ng) tl_Akt_fac(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_TNUDG') THEN Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) Tnudg(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_MORPH_FAC') THEN IF (.not.allocated(morph_fac)) THEN allocate (morph_fac(NST,Ngrids)) END IF Npts=load_r(Nval, Rval, NNS*Ngrids, Rsand) DO ng=1,Ngrids DO itrc=1,NNS i=NCS+itrc morph_fac(i,ng)=Rsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'SAND_Ltracer') THEN Npts=load_l(Nval, Cval, NNS*Ngrids, Lsand) DO ng=1,Ngrids DO itrc=1,NNS i=idsed(NCS+itrc) LtracerSrc(i,ng)=Lsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idsand)') THEN Npts=load_l(Nval, Cval, NNS*Ngrids, Lsand) DO ng=1,Ngrids DO itrc=1,NNS i=idTvar(idsed(NCS+itrc)) Hout(i,ng)=Lsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(iSfrac)') THEN Npts=load_l(Nval, Cval, NNS*Ngrids, Lsand) DO ng=1,Ngrids DO itrc=1,NNS i=idfrac(NCS+itrc) Hout(i,ng)=Lsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(iSmass)') THEN Npts=load_l(Nval, Cval, NNS*Ngrids, Lsand) DO ng=1,Ngrids DO itrc=1,NNS i=idBmas(NCS+itrc) Hout(i,ng)=Lsand(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(ithck)') THEN Npts=load_l(Nval, Cval, Ngrids, Lbed) i=idSbed(ithck) DO ng=1,Ngrids Hout(i,ng)=Lbed(ng) END DO ELSE IF (TRIM(KeyWord).eq.'Hout(iaged)') THEN Npts=load_l(Nval, Cval, Ngrids, Lbed) i=idSbed(iaged) DO ng=1,Ngrids Hout(i,ng)=Lbed(ng) END DO ELSE IF (TRIM(KeyWord).eq.'Hout(iporo)') THEN Npts=load_l(Nval, Cval, Ngrids, Lbed) i=idSbed(iporo) DO ng=1,Ngrids Hout(i,ng)=Lbed(ng) END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idiff)') THEN Npts=load_l(Nval, Cval, Ngrids, Lbed) i=idSbed(idiff) DO ng=1,Ngrids Hout(i,ng)=Lbed(ng) END DO END IF END IF END DO 10 IF (Master) WRITE (out,40) line exit_flag=4 RETURN 20 CONTINUE ! !----------------------------------------------------------------------- ! Report input parameters. !----------------------------------------------------------------------- ! IF (Lwrite) THEN DO ng=1,Ngrids IF (Lsediment(ng)) THEN WRITE (out,50) ng WRITE (out,60) DO itrc=1,NST WRITE (out,70) itrc, Sd50(itrc,ng), Csed(itrc,ng), & & Srho(itrc,ng), Wsed(itrc,ng), & & Erate(itrc,ng), poros(itrc,ng) END DO WRITE (out,80) DO itrc=1,NST i=idsed(itrc) WRITE (out,70) itrc, tau_ce(itrc,ng), tau_cd(itrc,ng), & & nl_tnu2(i,ng), nl_tnu4(i,ng), & & Akt_bak(i,ng), Tnudg(i,ng) END DO WRITE (out,90) DO itrc=1,NST WRITE (out,70) itrc, morph_fac(itrc,ng) END DO WRITE (out,100) newlayer_thick(ng) WRITE (out,110) minlayer_thick(ng) WRITE (out,120) bedload_coeff(ng) DO itrc=1,NST i=idsed(itrc) WRITE (out,150) LtracerSrc(i,ng), 'LtracerSrc', & & i, 'Processing point sources/Sink on tracer ', i, & & TRIM(Vname(1,idTvar(i))) END DO DO itrc=1,NST i=idTvar(idsed(itrc)) IF (Hout(i,ng)) WRITE (out,160) Hout(i,ng), & & 'Hout(idTvar)', & & 'Write out sediment', itrc, TRIM(Vname(1,i)) END DO DO itrc=1,NST i=idfrac(itrc) IF (Hout(i,ng)) WRITE (out,160) Hout(i,ng), & & 'Hout(idfrac)', & & 'Write out bed fraction, sediment ', itrc, & & TRIM(Vname(1,i)) END DO DO itrc=1,NST i=idBmas(itrc) IF (Hout(i,ng)) WRITE (out,160) Hout(i,ng), & & 'Hout(idfrac)', & & 'Write out mass, sediment ', itrc, & & TRIM(Vname(1,i)) END DO DO itrc=1,MBEDP i=idSbed(itrc) IF (Hout(i,ng)) WRITE (out,160) Hout(i,ng), & & 'Hout(idSbed)', & & 'Write out BED property ', itrc, TRIM(Vname(1,i)) END DO END IF END DO END IF ! !----------------------------------------------------------------------- ! Scale relevant input parameters !----------------------------------------------------------------------- ! DO ng=1,Ngrids DO i=1,NST Sd50(i,ng)=Sd50(i,ng)*0.001_r8 Wsed(i,ng)=Wsed(i,ng)*0.001_r8 tau_ce(i,ng)=tau_ce(i,ng)/rho0 tau_cd(i,ng)=tau_cd(i,ng)/rho0 nl_tnu4(idsed(i),ng)=SQRT(ABS(nl_tnu4(idsed(i),ng))) IF (Tnudg(idsed(i),ng).gt.0.0_r8) THEN Tnudg(idsed(i),ng)=1.0_r8/(Tnudg(idsed(i),ng)*86400.0_r8) ELSE Tnudg(idsed(i),ng)=0.0_r8 END IF END DO END DO 30 FORMAT (/,' READ_SedPar - variable info not yet loaded, ', a) 40 FORMAT (/,' READ_SedPar - Error while processing line: ',/,a) 50 FORMAT (/,/,' Sediment Parameters, Grid: ',i2.2, & & /, ' =============================',/) 60 FORMAT (/,1x,'Size',5x,'Sd50',8x,'Csed',8x,'Srho',8x,'Wsed', & & 8x,'Erate',7x,'poros',/,1x,'Class',4x,'(mm)',7x, & & '(kg/m3)',5x,'(kg/m3)',5x,'(mm/s)',5x,'(kg/m2/s)',4x, & & '(nondim)',/) 70 FORMAT (2x,i2,2x,6(1x,1p,e11.4)) 80 FORMAT (/,9x,'tau_ce',6x,'tau_cd',6x,'nl_tnu2',5x,'nl_tnu4',5x, & & 'Akt_bak',6x,'Tnudg',/,9x,'(N/m2)',6x,'(N/m2)',6x, & & '(m2/s)',6x,'(m4/s)',7x,'(m2/s)',6x,'(day)',/) 90 FORMAT (/,9x,'morph_fac',/,9x,'(nondim)',/) 100 FORMAT (/,' New bed layer formed when deposition exceeds ',e11.5, & & ' (m).') 110 FORMAT (' Two first layers are combined when 2nd layer smaller ', & & 'than ',e11.5,' (m).') 120 FORMAT (' Rate coefficient for bed load transport = ',e11.5,/) 130 FORMAT (' Transition for mixed sediment =',e11.5,/) 140 FORMAT (' Transition for cohesive sediment =',e11.5,/) 150 FORMAT (10x,l1,2x,a,'(',i2.2,')',t30,a,i2.2,':',1x,a) 160 FORMAT (10x,l1,2x,a,t29,a,i2.2,':',1x,a) RETURN END SUBROUTINE read_SedPar SUBROUTINE read_PhyPar (model, inp, out, Lwrite) ! !======================================================================= ! ! ! This routine reads in physical model input parameters. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_iounits USE mod_ncparam USE mod_netcdf USE mod_scalars USE mod_sediment USE mod_strings ! implicit none ! ! Imported variable declarations ! logical, intent(in) :: Lwrite integer, intent(in) :: model, inp, out ! ! Local variable declarations. ! logical :: inhere logical :: LreadNCS = .FALSE. logical :: LreadNNS = .FALSE. integer :: Lstr, Npts, Nval, i, itrc, k, ng, status integer :: decode_line, load_i, load_l, load_r logical, dimension(MBOTP,Ngrids) :: Lbottom logical, allocatable :: Ltracer(:,:) real(r8), allocatable :: Rtracer(:,:) real(r8), allocatable :: tracer(:,:) real(r8), dimension(100) :: Rval character (len=1 ), parameter :: blank = ' ' character (len=19) :: ref_att character (len=40) :: KeyWord character (len=160) :: fname, line character (len=160), dimension(100) :: Cval ! !----------------------------------------------------------------------- ! Read in physical model parameters. Then, load input data into module. ! Take into account nested grid configurations. !----------------------------------------------------------------------- ! DO WHILE (.TRUE.) READ (inp,'(a)',ERR=10,END=20) line status=decode_line(line, KeyWord, Nval, Cval, Rval) IF (status.gt.0) THEN IF (TRIM(KeyWord).eq.'TITLE') THEN IF (Nval.eq.1) THEN title=TRIM(ADJUSTL(Cval(Nval))) ELSE WRITE(title,'(a,1x,a)') TRIM(ADJUSTL(title)), & & TRIM(ADJUSTL(Cval(Nval))) END IF ELSE IF (TRIM(KeyWord).eq.'MyAppCPP') THEN DO i=1,LEN(MyAppCPP) MyAppCPP(i:i)=blank END DO MyAppCPP=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'VARNAME') THEN DO i=1,LEN(varname) varname(i:i)=blank END DO varname=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'Lm') THEN Npts=load_i(Nval, Rval, Ngrids, Lm) DO ng=1,Ngrids IF (Lm(ng).le.0) THEN IF (Master) WRITE (out,300) 'Lm', ng, & & 'must be greater than zero.' exit_flag=5 RETURN END IF END DO ELSE IF (TRIM(KeyWord).eq.'Mm') THEN Npts=load_i(Nval, Rval, Ngrids, Mm) DO ng=1,Ngrids IF (Mm(ng).le.0) THEN IF (Master) WRITE (out,300) 'Mm', ng, & & 'must be greater than zero.' exit_flag=5 RETURN END IF END DO ELSE IF (TRIM(KeyWord).eq.'N') THEN Npts=load_i(Nval, Rval, Ngrids, N) DO ng=1,Ngrids IF (N(ng).lt.0) THEN IF (Master) WRITE (out,300) 'N', ng, & & 'must be greater than zero.' exit_flag=5 RETURN END IF END DO ELSE IF (TRIM(KeyWord).eq.'Nbed') THEN Npts=load_i(Nval, Rval, 1, Nbed) IF (Nbed.le.0) THEN IF (Master) WRITE (out,290) 'Nbed = ', Nbed, & & 'must be greater than zero.' exit_flag=5 RETURN END IF ELSE IF (TRIM(KeyWord).eq.'NAT') THEN Npts=load_i(Nval, Rval, 1, NAT) IF ((NAT.lt.1).or.(NAT.gt.2)) THEN IF (Master) WRITE (out,290) 'NAT = ', NAT, & & 'make sure that NAT is either 1 or 2.' exit_flag=5 RETURN END IF IF (NAT.ne.2) THEN IF (Master) WRITE (out,290) 'NAT = ', NAT, & & 'make sure that NAT is equal to 2.' exit_flag=5 RETURN END IF ELSE IF (TRIM(KeyWord).eq.'NCS') THEN Npts=load_i(Nval, Rval, 1, NCS) IF (NCS.lt.0) THEN IF (Master) WRITE (out,290) 'NCS = ', NCS, & & 'must be greater than zero.' exit_flag=5 RETURN END IF LreadNCS=.TRUE. IF (LreadNNS.and.((NCS+NNS).le.0)) THEN IF (Master) WRITE (out,290) 'NST = ', NCS+NNS, & & 'either NCS or NNS must be greater than zero.' exit_flag=5 RETURN END IF NST=NST+NCS ELSE IF (TRIM(KeyWord).eq.'NNS') THEN Npts=load_i(Nval, Rval, 1, NNS) IF (NNS.lt.0) THEN IF (Master) WRITE (out,290) 'NNS = ', & & 'must be greater than zero.' exit_flag=5 RETURN END IF LreadNNS=.TRUE. IF (LreadNCS.and.((NCS+NNS).le.0)) THEN IF (Master) WRITE (out,290) 'NST = ', NCS+NNS, & & 'either NCS or NNS must be greater than zero.' exit_flag=5 RETURN END IF NST=NST+NNS ELSE IF (TRIM(KeyWord).eq.'NtileI') THEN Npts=load_i(Nval, Rval, Ngrids, NtileI) NtileX(1:Ngrids)=1 ELSE IF (TRIM(KeyWord).eq.'NtileJ') THEN Npts=load_i(Nval, Rval, Ngrids, NtileJ) NtileE(1:Ngrids)=1 CALL initialize_param CALL initialize_scalars CALL initialize_ncparam IF (.not.allocated(Ltracer)) THEN allocate (Ltracer(NAT+NPT,Ngrids)) END IF IF (.not.allocated(Rtracer)) THEN allocate (Rtracer(NAT+NPT,Ngrids)) END IF IF (.not.allocated(tracer)) THEN allocate (tracer(MT,Ngrids)) END IF ELSE IF (TRIM(KeyWord).eq.'NTIMES') THEN Npts=load_i(Nval, Rval, Ngrids, ntimes) ELSE IF (TRIM(KeyWord).eq.'DT') THEN Npts=load_r(Nval, Rval, Ngrids, dt) ELSE IF (TRIM(KeyWord).eq.'NDTFAST') THEN Npts=load_i(Nval, Rval, Ngrids, ndtfast) ELSE IF (TRIM(KeyWord).eq.'ERstr') THEN Npts=load_i(Nval, Rval, 1, ERstr) ELSE IF (TRIM(KeyWord).eq.'ERend') THEN Npts=load_i(Nval, Rval, 1, ERend) ELSE IF (TRIM(KeyWord).eq.'Nouter') THEN Npts=load_i(Nval, Rval, 1, Nouter) ELSE IF (TRIM(KeyWord).eq.'Ninner') THEN Npts=load_i(Nval, Rval, 1, Ninner) ELSE IF (TRIM(KeyWord).eq.'Nintervals') THEN Npts=load_i(Nval, Rval, 1, Nintervals) ELSE IF (TRIM(KeyWord).eq.'NRREC') THEN Npts=load_i(Nval, Rval, Ngrids, nrrec) DO ng=1,Ngrids IF (nrrec(ng).lt.0) THEN LastRec(ng)=.TRUE. ELSE LastRec(ng)=.FALSE. END IF END DO ELSE IF (TRIM(KeyWord).eq.'LcycleRST') THEN Npts=load_l(Nval, Cval, Ngrids, LcycleRST) ELSE IF (TRIM(KeyWord).eq.'NRST') THEN Npts=load_i(Nval, Rval, Ngrids, nRST) ELSE IF (TRIM(KeyWord).eq.'NSTA') THEN Npts=load_i(Nval, Rval, Ngrids, nSTA) ELSE IF (TRIM(KeyWord).eq.'NFLT') THEN Npts=load_i(Nval, Rval, Ngrids, nFLT) ELSE IF (TRIM(KeyWord).eq.'NINFO') THEN Npts=load_i(Nval, Rval, Ngrids, ninfo) ELSE IF (TRIM(KeyWord).eq.'LDEFOUT') THEN Npts=load_l(Nval, Cval, Ngrids, ldefout) ELSE IF (TRIM(KeyWord).eq.'NHIS') THEN Npts=load_i(Nval, Rval, Ngrids, nHIS) ELSE IF (TRIM(KeyWord).eq.'NDEFHIS') THEN Npts=load_i(Nval, Rval, Ngrids, ndefHIS) ELSE IF (TRIM(KeyWord).eq.'NTSAVG') THEN Npts=load_i(Nval, Rval, Ngrids, ntsAVG) ELSE IF (TRIM(KeyWord).eq.'NAVG') THEN Npts=load_i(Nval, Rval, Ngrids, nAVG) ELSE IF (TRIM(KeyWord).eq.'NDEFAVG') THEN Npts=load_i(Nval, Rval, Ngrids, ndefAVG) ELSE IF (TRIM(KeyWord).eq.'NTSDIA') THEN Npts=load_i(Nval, Rval, Ngrids, ntsDIA) ELSE IF (TRIM(KeyWord).eq.'NDIA') THEN Npts=load_i(Nval, Rval, Ngrids, nDIA) ELSE IF (TRIM(KeyWord).eq.'NDEFDIA') THEN Npts=load_i(Nval, Rval, Ngrids, ndefDIA) ELSE IF (TRIM(KeyWord).eq.'LcycleTLM') THEN Npts=load_l(Nval, Cval, Ngrids, LcycleTLM) ELSE IF (TRIM(KeyWord).eq.'NTLM') THEN Npts=load_i(Nval, Rval, Ngrids, nTLM) ELSE IF (TRIM(KeyWord).eq.'NDEFTLM') THEN Npts=load_i(Nval, Rval, Ngrids, ndefTLM) ELSE IF (TRIM(KeyWord).eq.'LcycleADJ') THEN Npts=load_l(Nval, Cval, Ngrids, LcycleADJ) ELSE IF (TRIM(KeyWord).eq.'NADJ') THEN Npts=load_i(Nval, Rval, Ngrids, nADJ) ELSE IF (TRIM(KeyWord).eq.'NDEFADJ') THEN Npts=load_i(Nval, Rval, Ngrids, ndefADJ) ELSE IF (TRIM(KeyWord).eq.'NOBC') THEN Npts=load_i(Nval, Rval, Ngrids, nOBC) ELSE IF (TRIM(KeyWord).eq.'NSFF') THEN Npts=load_i(Nval, Rval, Ngrids, nSFF) ELSE IF (TRIM(KeyWord).eq.'LrstGST') THEN Npts=load_l(Nval, Cval, 1, LrstGST) ELSE IF (TRIM(KeyWord).eq.'MaxIterGST') THEN Npts=load_i(Nval, Rval, 1, MaxIterGST) ELSE IF (TRIM(KeyWord).eq.'NGST') THEN Npts=load_i(Nval, Rval, 1, nGST) ELSE IF (TRIM(KeyWord).eq.'TNU2') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT nl_tnu2(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'TNU4') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT nl_tnu4(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_TNU2') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT ad_tnu2(itrc,ng)=Rtracer(itrc,ng) tl_tnu2(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_TNU4') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT ad_tnu4(itrc,ng)=Rtracer(itrc,ng) tl_tnu4(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'VISC2') THEN Npts=load_r(Nval, Rval, Ngrids, nl_visc2) ELSE IF (TRIM(KeyWord).eq.'VISC4') THEN Npts=load_r(Nval, Rval, Ngrids, nl_visc4) ELSE IF (TRIM(KeyWord).eq.'ad_VISC2') THEN Npts=load_r(Nval, Rval, Ngrids, ad_visc2) DO ng=1,Ngrids tl_visc2(ng)=ad_visc2(ng) END DO ELSE IF (TRIM(KeyWord).eq.'VISC4') THEN Npts=load_r(Nval, Rval, Ngrids, ad_visc4) DO ng=1,Ngrids tl_visc4(ng)=ad_visc4(ng) END DO ELSE IF (TRIM(KeyWord).eq.'AKT_BAK') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT Akt_bak(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ad_AKT_fac') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT ad_Akt_fac(itrc,ng)=Rtracer(itrc,ng) tl_Akt_fac(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'AKV_BAK') THEN Npts=load_r(Nval, Rval, Ngrids, Akv_bak) ELSE IF (TRIM(KeyWord).eq.'ad_AKV_fac') THEN Npts=load_r(Nval, Rval, Ngrids, ad_Akv_fac) DO ng=1,Ngrids tl_Akv_fac(ng)=ad_AKv_fac(ng) END DO ELSE IF (TRIM(KeyWord).eq.'AKK_BAK') THEN Npts=load_r(Nval, Rval, Ngrids, Akk_bak) ELSE IF (TRIM(KeyWord).eq.'AKP_BAK') THEN Npts=load_r(Nval, Rval, Ngrids, Akp_bak) ELSE IF (TRIM(KeyWord).eq.'TKENU2') THEN Npts=load_r(Nval, Rval, Ngrids, tkenu2) ELSE IF (TRIM(KeyWord).eq.'TKENU4') THEN Npts=load_r(Nval, Rval, Ngrids, tkenu4) ELSE IF (TRIM(KeyWord).eq.'GLS_P') THEN Npts=load_r(Nval, Rval, Ngrids, gls_p) ELSE IF (TRIM(KeyWord).eq.'GLS_M') THEN Npts=load_r(Nval, Rval, Ngrids, gls_m) ELSE IF (TRIM(KeyWord).eq.'GLS_N') THEN Npts=load_r(Nval, Rval, Ngrids, gls_n) ELSE IF (TRIM(KeyWord).eq.'GLS_Kmin') THEN Npts=load_r(Nval, Rval, Ngrids, gls_Kmin) ELSE IF (TRIM(KeyWord).eq.'GLS_Pmin') THEN Npts=load_r(Nval, Rval, Ngrids, gls_Pmin) ELSE IF (TRIM(KeyWord).eq.'GLS_CMU0') THEN Npts=load_r(Nval, Rval, Ngrids, gls_cmu0) ELSE IF (TRIM(KeyWord).eq.'GLS_C1') THEN Npts=load_r(Nval, Rval, Ngrids, gls_c1) ELSE IF (TRIM(KeyWord).eq.'GLS_C2') THEN Npts=load_r(Nval, Rval, Ngrids, gls_c2) ELSE IF (TRIM(KeyWord).eq.'GLS_C3M') THEN Npts=load_r(Nval, Rval, Ngrids, gls_c3m) ELSE IF (TRIM(KeyWord).eq.'GLS_C3P') THEN Npts=load_r(Nval, Rval, Ngrids, gls_c3p) ELSE IF (TRIM(KeyWord).eq.'GLS_SIGK') THEN Npts=load_r(Nval, Rval, Ngrids, gls_sigk) ELSE IF (TRIM(KeyWord).eq.'GLS_SIGP') THEN Npts=load_r(Nval, Rval, Ngrids, gls_sigp) ELSE IF (TRIM(KeyWord).eq.'CHARNOK_ALPHA') THEN Npts=load_r(Nval, Rval, Ngrids, charnok_alpha) ELSE IF (TRIM(KeyWord).eq.'ZOS_HSIG_ALPHA') THEN Npts=load_r(Nval, Rval, Ngrids, zos_hsig_alpha) ELSE IF (TRIM(KeyWord).eq.'SZ_ALPHA') THEN Npts=load_r(Nval, Rval, Ngrids, sz_alpha) ELSE IF (TRIM(KeyWord).eq.'CRGBAN_CW') THEN Npts=load_r(Nval, Rval, Ngrids, crgban_cw) ELSE IF (TRIM(KeyWord).eq.'RDRG') THEN Npts=load_r(Nval, Rval, Ngrids, rdrg) ELSE IF (TRIM(KeyWord).eq.'RDRG2') THEN Npts=load_r(Nval, Rval, Ngrids, rdrg2) ELSE IF (TRIM(KeyWord).eq.'Zob') THEN Npts=load_r(Nval, Rval, Ngrids, Zob) ELSE IF (TRIM(KeyWord).eq.'Zos') THEN Npts=load_r(Nval, Rval, Ngrids, Zos) ELSE IF (TRIM(KeyWord).eq.'BLK_ZQ') THEN Npts=load_r(Nval, Rval, Ngrids, blk_ZQ) ELSE IF (TRIM(KeyWord).eq.'BLK_ZT') THEN Npts=load_r(Nval, Rval, Ngrids, blk_ZT) ELSE IF (TRIM(KeyWord).eq.'BLK_ZW') THEN Npts=load_r(Nval, Rval, Ngrids, blk_ZW) ELSE IF (TRIM(KeyWord).eq.'DCRIT') THEN Npts=load_r(Nval, Rval, Ngrids, Dcrit) ELSE IF (TRIM(KeyWord).eq.'WTYPE') THEN Npts=load_i(Nval, Rval, Ngrids, lmd_Jwt) ELSE IF (TRIM(KeyWord).eq.'LEVSFRC') THEN Npts=load_i(Nval, Rval, Ngrids, levsfrc) ELSE IF (TRIM(KeyWord).eq.'LEVBFRC') THEN Npts=load_i(Nval, Rval, Ngrids, levbfrc) ELSE IF (TRIM(KeyWord).eq.'Vtransform') THEN Npts=load_i(Nval, Rval, Ngrids, Vtransform) DO ng=1,Ngrids IF ((Vtransform(ng).lt.0).or. & & (Vtransform(ng).gt.2)) THEN IF (Master) WRITE (out,260) 'Vtransform = ', & & Vtransform(ng), & & 'Must be either 1 or 2' exit_flag=5 RETURN END IF END DO ELSE IF (TRIM(KeyWord).eq.'Vstretching') THEN Npts=load_i(Nval, Rval, Ngrids, Vstretching) DO ng=1,Ngrids IF ((Vstretching(ng).lt.0).or. & & (Vstretching(ng).gt.3)) THEN IF (Master) WRITE (out,260) 'Vstretching = ', & & Vstretching(ng), & & 'Must between 1 and 3' exit_flag=5 RETURN END IF END DO ELSE IF (TRIM(KeyWord).eq.'THETA_S') THEN Npts=load_r(Nval, Rval, Ngrids, theta_s) ELSE IF (TRIM(KeyWord).eq.'THETA_B') THEN Npts=load_r(Nval, Rval, Ngrids, theta_b) ELSE IF (TRIM(KeyWord).eq.'TCLINE') THEN Npts=load_r(Nval, Rval, Ngrids, Tcline) DO ng=1,Ngrids hc(ng)=Tcline(ng) END DO ELSE IF (TRIM(KeyWord).eq.'RHO0') THEN Npts=load_r(Nval, Rval, 1, rho0) ELSE IF (TRIM(KeyWord).eq.'BVF_BAK') THEN Npts=load_r(Nval, Rval, 1, bvf_bak) ELSE IF (TRIM(KeyWord).eq.'DSTART') THEN Npts=load_r(Nval, Rval, 1, dstart) ELSE IF (TRIM(KeyWord).eq.'TIDE_START') THEN Npts=load_r(Nval, Rval, 1, tide_start) ELSE IF (TRIM(KeyWord).eq.'TIME_REF') THEN Npts=load_r(Nval, Rval, 1, time_ref) r_text=ref_att(time_ref,r_date) ELSE IF (TRIM(KeyWord).eq.'TNUDG') THEN Npts=load_r(Nval, Rval, (NAT+NPT)*Ngrids, Rtracer) DO ng=1,Ngrids DO itrc=1,NAT+NPT Tnudg(itrc,ng)=Rtracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'ZNUDG') THEN Npts=load_r(Nval, Rval, Ngrids, Znudg) ELSE IF (TRIM(KeyWord).eq.'M2NUDG') THEN Npts=load_r(Nval, Rval, Ngrids, M2nudg) ELSE IF (TRIM(KeyWord).eq.'M3NUDG') THEN Npts=load_r(Nval, Rval, Ngrids, M3nudg) ELSE IF (TRIM(KeyWord).eq.'OBCFAC') THEN Npts=load_r(Nval, Rval, Ngrids, obcfac) ELSE IF (TRIM(KeyWord).eq.'R0') THEN Npts=load_r(Nval, Rval, Ngrids, R0) DO ng=1,Ngrids IF (R0(ng).lt.100.0_r8) R0(ng)=R0(ng)+1000.0_r8 END DO ELSE IF (TRIM(KeyWord).eq.'T0') THEN Npts=load_r(Nval, Rval, Ngrids, T0) ELSE IF (TRIM(KeyWord).eq.'S0') THEN Npts=load_r(Nval, Rval, Ngrids, S0) ELSE IF (TRIM(KeyWord).eq.'TCOEF') THEN Npts=load_r(Nval, Rval, Ngrids, Tcoef) DO ng=1,Ngrids Tcoef(ng)=ABS(Tcoef(ng)) END DO ELSE IF (TRIM(KeyWord).eq.'SCOEF') THEN Npts=load_r(Nval, Rval, Ngrids, Scoef) DO ng=1,Ngrids Scoef(ng)=ABS(Scoef(ng)) END DO ELSE IF (TRIM(KeyWord).eq.'GAMMA2') THEN Npts=load_r(Nval, Rval, Ngrids, gamma2) ELSE IF (TRIM(KeyWord).eq.'LtracerSrc') THEN Npts=load_l(Nval, Cval, (NAT+NPT)*Ngrids, Ltracer) DO ng=1,Ngrids DO itrc=1,NAT LtracerSrc(itrc,ng)=Ltracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idFsur)') THEN IF (idFsur.eq.0) THEN IF (Master) WRITE (out,280) 'idFsur' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idFsur,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbar)') THEN IF (idUbar.eq.0) THEN IF (Master) WRITE (out,280) 'idUbar' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbar,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbar)') THEN IF (idVbar.eq.0) THEN IF (Master) WRITE (out,280) 'idVbar' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbar,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUvel)') THEN IF (idUvel.eq.0) THEN IF (Master) WRITE (out,280) 'idUvel' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUvel,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVvel)') THEN IF (idVvel.eq.0) THEN IF (Master) WRITE (out,280) 'idVvel' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVvel,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idWvel)') THEN IF (idWvel.eq.0) THEN IF (Master) WRITE (out,280) 'idWvel' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idWvel,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idOvel)') THEN IF (idOvel.eq.0) THEN IF (Master) WRITE (out,280) 'idOvel' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idOvel,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idTvar)') THEN IF (MAXVAL(idTvar).eq.0) THEN IF (Master) WRITE (out,280) 'idTvar' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, NAT*Ngrids, Ltracer) DO ng=1,Ngrids DO itrc=1,NAT i=idTvar(itrc) Hout(i,ng)=Ltracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idUsms)') THEN IF (idUsms.eq.0) THEN IF (Master) WRITE (out,280) 'idUsms' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUsms,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVsms)') THEN IF (idVsms.eq.0) THEN IF (Master) WRITE (out,280) 'idVsms' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVsms,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbms)') THEN IF (idUbms.eq.0) THEN IF (Master) WRITE (out,280) 'idUbms' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbms,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbms)') THEN IF (idVbms.eq.0) THEN IF (Master) WRITE (out,280) 'idVbms' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbms,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbrs)') THEN IF (idUbrs.eq.0) THEN IF (Master) WRITE (out,280) 'idUbrs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbrs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbrs)') THEN IF (idVbrs.eq.0) THEN IF (Master) WRITE (out,280) 'idVbrs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbrs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbws)') THEN IF (idUbws.eq.0) THEN IF (Master) WRITE (out,280) 'idUbws' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbws,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbws)') THEN IF (idVbws.eq.0) THEN IF (Master) WRITE (out,280) 'idVbws' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbws,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbcs)') THEN IF (idUbcs.eq.0) THEN IF (Master) WRITE (out,280) 'idUbcs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbcs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbcs)') THEN IF (idVbcs.eq.0) THEN IF (Master) WRITE (out,280) 'idVbcs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbcs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbot)') THEN IF (idUbot.eq.0) THEN IF (Master) WRITE (out,280) 'idUbot' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbot,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbot)') THEN IF (idVbot.eq.0) THEN IF (Master) WRITE (out,280) 'idVbot' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbot,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idUbur)') THEN IF (idUbur.eq.0) THEN IF (Master) WRITE (out,280) 'idUbur' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idUbur,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVbvr)') THEN IF (idVbvr.eq.0) THEN IF (Master) WRITE (out,280) 'idVbvr' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVbvr,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW2xx)') THEN IF (idW2xx.eq.0) THEN IF (Master) WRITE (out,280) 'idW2xx' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW2xx,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW2xy)') THEN IF (idW2xy.eq.0) THEN IF (Master) WRITE (out,280) 'idW2xy' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW2xy,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW2yy)') THEN IF (idW2yy.eq.0) THEN IF (Master) WRITE (out,280) 'idW2yy' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW2yy,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW3xx)') THEN IF (idW3xx.eq.0) THEN IF (Master) WRITE (out,280) 'idW3xx' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW3xx,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW3xy)') THEN IF (idW3xy.eq.0) THEN IF (Master) WRITE (out,280) 'idW3xy' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW3xy,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW3yy)') THEN IF (idW3yy.eq.0) THEN IF (Master) WRITE (out,280) 'idW3yy' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW3yy,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW3zx)') THEN IF (idW3zx.eq.0) THEN IF (Master) WRITE (out,280) 'idW3zx' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW3zx,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idW3zy)') THEN IF (idW3zy.eq.0) THEN IF (Master) WRITE (out,280) 'idW3zy' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idW3zy,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idU2rs)') THEN IF (idU2rs.eq.0) THEN IF (Master) WRITE (out,280) 'idU2rs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idU2rs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idV2rs)') THEN IF (idV2rs.eq.0) THEN IF (Master) WRITE (out,280) 'idV2rs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idV2rs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idU2Sd)') THEN IF (idU2Sd.eq.0) THEN IF (Master) WRITE (out,280) 'idU2Sd' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idU2Sd,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idV2Sd)') THEN IF (idV2Sd.eq.0) THEN IF (Master) WRITE (out,280) 'idV2Sd' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idV2Sd,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idU3rs)') THEN IF (idU3rs.eq.0) THEN IF (Master) WRITE (out,280) 'idU3rs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idU3rs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idV3rs)') THEN IF (idV3rs.eq.0) THEN IF (Master) WRITE (out,280) 'idV3rs' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idV3rs,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idU3Sd)') THEN IF (idU3Sd.eq.0) THEN IF (Master) WRITE (out,280) 'idU3Sd' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idU3Sd,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idV3Sd)') THEN IF (idV3Sd.eq.0) THEN IF (Master) WRITE (out,280) 'idV3Sd' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idV3Sd,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idWamp)') THEN IF (idWamp.eq.0) THEN IF (Master) WRITE (out,280) 'idWamp' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idWamp,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idWlen)') THEN IF (idWlen.eq.0) THEN IF (Master) WRITE (out,280) 'idWlen' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idWlen,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idWdir)') THEN IF (idWdir.eq.0) THEN IF (Master) WRITE (out,280) 'idWdir' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idWdir,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idTsur)') THEN IF (idTsur(itemp).eq.0) THEN IF (Master) WRITE (out,280) 'idTsur' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, NAT*Ngrids, Ltracer) DO ng=1,Ngrids DO itrc=1,NAT i=idTsur(itrc) Hout(i,ng)=Ltracer(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'Hout(idLhea)') THEN IF (idLhea.eq.0) THEN IF (Master) WRITE (out,280) 'idLhea' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idLhea,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idShea)') THEN IF (idShea.eq.0) THEN IF (Master) WRITE (out,280) 'idShea' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idShea,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idLrad)') THEN IF (idLrad.eq.0) THEN IF (Master) WRITE (out,280) 'idLrad' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idLrad,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idSrad)') THEN IF (idSrad.eq.0) THEN IF (Master) WRITE (out,280) 'idSrad' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idSrad,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idEmPf)') THEN IF (idEmPf.eq.0) THEN IF (Master) WRITE (out,280) 'idEmPf' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idEmPf,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idevap)') THEN IF (idevap.eq.0) THEN IF (Master) WRITE (out,280) 'idevap' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idevap,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idrain)') THEN IF (idrain.eq.0) THEN IF (Master) WRITE (out,280) 'idrain' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idrain,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idDano)') THEN IF (idDano.eq.0) THEN IF (Master) WRITE (out,280) 'idDano' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idDano,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idVvis)') THEN IF (idVvis.eq.0) THEN IF (Master) WRITE (out,280) 'idVvis' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idVvis,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idTdif)') THEN IF (idTdif.eq.0) THEN IF (Master) WRITE (out,280) 'idTdif' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idTdif,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idSdif)') THEN IF (idSdif.eq.0) THEN IF (Master) WRITE (out,280) 'idSdif' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idSdif,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idHsbl)') THEN IF (idHsbl.eq.0) THEN IF (Master) WRITE (out,280) 'idHsbl' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idHsbl,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idHbbl)') THEN IF (idHbbl.eq.0) THEN IF (Master) WRITE (out,280) 'idHbbl' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idHbbl,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idMtke)') THEN IF (idMtke.eq.0) THEN IF (Master) WRITE (out,280) 'idMtke' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idMtke,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idMtls)') THEN IF (idMtls.eq.0) THEN IF (Master) WRITE (out,280) 'idMtls' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, Ngrids, Hout(idMtls,:)) ELSE IF (TRIM(KeyWord).eq.'Hout(idBott)') THEN IF (MAXVAL(idBott).eq.0) THEN WRITE (out,280) 'idBott' exit_flag=5 RETURN END IF Npts=load_l(Nval, Cval, MBOTP*Ngrids, Lbottom) DO ng=1,Ngrids DO itrc=1,MBOTP i=idBott(itrc) Hout(i,ng)=Lbottom(itrc,ng) END DO END DO ELSE IF (TRIM(KeyWord).eq.'NUSER') THEN Npts=load_i(Nval, Rval, 1, Nuser) ELSE IF (TRIM(KeyWord).eq.'USER') THEN Npts=load_r(Nval, Rval, MAX(1,Nuser), user) ELSE IF (TRIM(KeyWord).eq.'NC_SHUFFLE') THEN Npts=load_i(Nval, Rval, 1, shuffle) ELSE IF (TRIM(KeyWord).eq.'NC_DEFLATE') THEN Npts=load_i(Nval, Rval, 1, deflate) ELSE IF (TRIM(KeyWord).eq.'NC_DLEVEL') THEN Npts=load_i(Nval, Rval, 1, deflate_level) ELSE IF (TRIM(KeyWord).eq.'GSTNAME') THEN DO i=1,LEN(GSTname(Nval)) GSTname(Nval)(i:i)=blank END DO GSTname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'RSTNAME') THEN DO i=1,LEN(RSTname(Nval)) RSTname(Nval)(i:i)=blank END DO RSTname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'HISNAME') THEN DO i=1,LEN(HISname(Nval)) HISname(Nval)(i:i)=blank HISbase(Nval)(i:i)=blank END DO HISname(Nval)=TRIM(ADJUSTL(Cval(Nval))) HISbase(Nval)=TRIM(ADJUSTL(HISname(Nval))) ELSE IF (TRIM(KeyWord).eq.'TLMNAME') THEN DO i=1,LEN(TLMname(Nval)) TLMname(Nval)(i:i)=blank TLMbase(Nval)(i:i)=blank END DO TLMname(Nval)=TRIM(ADJUSTL(Cval(Nval))) TLMbase(Nval)=TRIM(ADJUSTL(TLMname(Nval))) ELSE IF (TRIM(KeyWord).eq.'TLFNAME') THEN DO i=1,LEN(TLMname(Nval)) TLFname(Nval)(i:i)=blank END DO TLFname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'ADJNAME') THEN DO i=1,LEN(ADJname(Nval)) ADJname(Nval)(i:i)=blank ADJbase(Nval)(i:i)=blank END DO ADJname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ADJbase(Nval)=TRIM(ADJUSTL(ADJname(Nval))) ELSE IF (TRIM(KeyWord).eq.'AVGNAME') THEN DO i=1,LEN(AVGname(Nval)) AVGname(Nval)(i:i)=blank AVGbase(Nval)(i:i)=blank END DO AVGname(Nval)=TRIM(ADJUSTL(Cval(Nval))) AVGbase(Nval)=TRIM(ADJUSTL(AVGname(Nval))) ELSE IF (TRIM(KeyWord).eq.'DIANAME') THEN DO i=1,LEN(DIAname(Nval)) DIAname(Nval)(i:i)=blank DIAbase(Nval)(i:i)=blank END DO DIAname(Nval)=TRIM(ADJUSTL(Cval(Nval))) DIAbase(Nval)=TRIM(ADJUSTL(DIAname(Nval))) ELSE IF (TRIM(KeyWord).eq.'STANAME') THEN DO i=1,LEN(STAname(Nval)) STAname(Nval)(i:i)=blank END DO STAname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'FLTNAME') THEN DO i=1,LEN(FLTname(Nval)) FLTname(Nval)(i:i)=blank END DO FLTname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'GRDNAME') THEN DO i=1,LEN(GRDname(Nval)) GRDname(Nval)(i:i)=blank END DO GRDname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'ININAME') THEN DO i=1,LEN(INIname(Nval)) INIname(Nval)(i:i)=blank END DO INIname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'IRPNAME') THEN DO i=1,LEN(ITLname(Nval)) IRPname(Nval)(i:i)=blank END DO IRPname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'ITLNAME') THEN DO i=1,LEN(ITLname(Nval)) ITLname(Nval)(i:i)=blank END DO ITLname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'IADNAME') THEN DO i=1,LEN(IADname(Nval)) IADname(Nval)(i:i)=blank END DO IADname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'NFFILES') THEN Npts=load_i(Nval, Rval, Ngrids, nFfiles) DO ng=1,Ngrids IF (nFfiles(ng).le.0) THEN IF (Master) WRITE (out,260) 'NFFILES', & & 'Must be equal or greater than one.' exit_flag=4 RETURN END IF END DO Npts=MAXVAL(nFfiles) allocate ( FRCids (Npts,Ngrids) ) allocate ( FRCname(Npts,Ngrids) ) FRCids(1:Npts,1:Ngrids)=-1 DO ng=1,Ngrids DO k=1,Npts DO i=1,LEN(FRCname(k,ng)) FRCname(k,ng)(i:i)=blank END DO END DO END DO ELSE IF (TRIM(KeyWord).eq.'FRCNAME') THEN DO ng=1,Ngrids DO i=1,nFfiles(ng) IF (Nval.eq.(i+(Ngrids-1)*nFfiles(ng))) THEN FRCname(i,ng)=TRIM(ADJUSTL(Cval(Nval))) END IF END DO END DO ELSE IF (TRIM(KeyWord).eq.'CLMNAME') THEN DO i=1,LEN(CLMname(Nval)) CLMname(Nval)(i:i)=blank END DO CLMname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'BRYNAME') THEN DO i=1,LEN(BRYname(Nval)) BRYname(Nval)(i:i)=blank END DO BRYname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'FWDNAME') THEN DO i=1,LEN(FWDname(Nval)) FWDname(Nval)(i:i)=blank FWDbase(Nval)(i:i)=blank END DO FWDname(Nval)=TRIM(ADJUSTL(Cval(Nval))) FWDbase(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'ADSNAME') THEN DO i=1,LEN(ADSname(Nval)) ADSname(Nval)(i:i)=blank END DO ADSname(Nval)=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'APARNAM') THEN DO i=1,LEN(aparnam) aparnam(i:i)=blank END DO aparnam=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'SPOSNAM') THEN DO i=1,LEN(sposnam) sposnam(i:i)=blank END DO sposnam=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'FPOSNAM') THEN DO i=1,LEN(fposnam) fposnam(i:i)=blank END DO fposnam=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'BPARNAM') THEN DO i=1,LEN(bparnam) bparnam(i:i)=blank END DO bparnam=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'SPARNAM') THEN DO i=1,LEN(sparnam) sparnam(i:i)=blank END DO sparnam=TRIM(ADJUSTL(Cval(Nval))) ELSE IF (TRIM(KeyWord).eq.'USRNAME') THEN DO i=1,LEN(USRname) USRname(i:i)=blank END DO USRname=TRIM(ADJUSTL(Cval(Nval))) END IF END IF END DO 10 IF (Master) WRITE (out,50) line exit_flag=4 RETURN 20 CLOSE (inp) ! ! Set switch to create NetCDF file. ! DO ng=1,Ngrids DO i=1,NV IF (Hout(i,ng)) LdefHIS(ng)=.TRUE. END DO IF (((nrrec(ng).eq.0).and.(nAVG(ng).gt.ntimes(ng))).or. & & (nAVG(ng).eq.0)) THEN LdefAVG(ng)=.FALSE. END IF IF (((nrrec(ng).eq.0).and.(nDIA(ng).gt.ntimes(ng))).or. & & (nDIA(ng).eq.0)) THEN LdefDIA(ng)=.FALSE. END IF IF (((nrrec(ng).eq.0).and.(nFLT(ng).gt.ntimes(ng))).or. & & (nFLT(ng).eq.0)) THEN LdefFLT(ng)=.FALSE. END IF IF (((nrrec(ng).eq.0).and.(nHIS(ng).gt.ntimes(ng))).or. & & (nHIS(ng).eq.0)) THEN LdefHIS(ng)=.FALSE. END IF IF (((nrrec(ng).eq.0).and.(nRST(ng).gt.ntimes(ng))).or. & & (nRST(ng).eq.0)) THEN LdefRST(ng)=.FALSE. END IF IF (((nrrec(ng).eq.0).and.(nSTA(ng).gt.ntimes(ng))).or. & & (nSTA(ng).eq.0)) THEN LdefSTA(ng)=.FALSE. END IF END DO ! !----------------------------------------------------------------------- ! Report input parameters. !----------------------------------------------------------------------- ! IF (Lwrite) THEN WRITE (out,60) TRIM(title), TRIM(my_os), TRIM(my_cpu), & & TRIM(my_fort), TRIM(my_fc), TRIM(my_fflags), & & TRIM(Iname), TRIM(svn_url), TRIM(svn_rev), & & TRIM(Rdir), TRIM(Hdir), TRIM(Hfile), TRIM(Adir) DO ng=1,Ngrids ! ! Report grid size and domain decomposition. Check for correct tile ! decomposition. ! WRITE (out,70) ng, Lm(ng), Mm(ng), N(ng), numnodes, & & NtileI(ng), NtileJ(ng) IF ((NtileI(ng)*NtileJ(ng)).ne.numnodes) THEN WRITE (out,80) ng exit_flag=6 RETURN END IF ! ! Report physical parameters. ! WRITE (out,110) ng WRITE (out,120) ntimes(ng), 'ntimes', & & 'Number of timesteps for 3-D equations.' WRITE (out,140) dt(ng), 'dt', & & 'Timestep size (s) for 3-D equations.' WRITE (out,130) ndtfast(ng), 'ndtfast', & & 'Number of timesteps for 2-D equations between', & & 'each 3D timestep.' WRITE (out,120) ERstr, 'ERstr', & & 'Starting ensemble/perturbation run number.' WRITE (out,120) ERend, 'ERend', & & 'Ending ensemble/perturbation run number.' WRITE (out,120) nrrec(ng), 'nrrec', & & 'Number of restart records to read from disk.' WRITE (out,170) LcycleRST(ng), 'LcycleRST', & & 'Switch to recycle time-records in restart file.' WRITE (out,130) nRST(ng), 'nRST', & & 'Number of timesteps between the writing of data', & & 'into restart fields.' WRITE (out,130) ninfo(ng), 'ninfo', & & 'Number of timesteps between print of information', & & 'to standard output.' WRITE (out,130) nFLT(ng), 'nFLT', & & 'Number of timesteps between the writing of data', & & 'into floats file.' WRITE (out,170) ldefout(ng), 'ldefout', & & 'Switch to create a new output NetCDF file(s).' WRITE (out,130) nHIS(ng), 'nHIS', & & 'Number of timesteps between the writing fields', & & 'into history file.' IF (ndefHIS(ng).gt.0) THEN WRITE (out,130) ndefHIS(ng), 'ndefHIS', & & 'Number of timesteps between creation of new', & & 'history files.' END IF DO itrc=1,NAT+NPT WRITE (out,190) nl_tnu2(itrc,ng), 'nl_tnu2', itrc, & & 'NLM Horizontal, harmonic mixing coefficient', & & '(m2/s) for tracer ', itrc, & & TRIM(Vname(1,idTvar(itrc))) END DO DO itrc=1,NAT+NPT WRITE (out,190) Akt_bak(itrc,ng), 'Akt_bak', itrc, & & 'Background vertical mixing coefficient (m2/s)', & & 'for tracer ', itrc, TRIM(Vname(1,idTvar(itrc))) END DO WRITE (out,210) Akv_bak(ng), 'Akv_bak', & & 'Background vertical mixing coefficient (m2/s)', & & 'for momentum.' WRITE (out,210) Akk_bak(ng), 'Akk_bak', & & 'Background vertical mixing coefficient (m2/s)', & & 'for turbulent energy.' WRITE (out,210) Akp_bak(ng), 'Akp_bak', & & 'Background vertical mixing coefficient (m2/s)', & & 'for turbulent generic statistical field.' WRITE (out,140) gls_p(ng), 'gls_p', & & 'GLS stability exponent.' WRITE (out,140) gls_m(ng), 'gls_m', & & 'GLS turbulent kinetic energy exponent.' WRITE (out,140) gls_n(ng), 'gls_n', & & 'GLS turbulent length scale exponent.' WRITE (out,200) gls_Kmin(ng), 'gls_Kmin', & & 'GLS minimum value of turbulent kinetic energy.' WRITE (out,200) gls_Pmin(ng), 'gls_Pmin', & & 'GLS minimum value of dissipation.' WRITE (out,200) gls_cmu0(ng), 'gls_cmu0', & & 'GLS stability coefficient.' WRITE (out,200) gls_c1(ng), 'gls_c1', & & 'GLS shear production coefficient.' WRITE (out,200) gls_c2(ng), 'gls_c2', & & 'GLS dissipation coefficient.' WRITE (out,200) gls_c3m(ng), 'gls_c3m', & & 'GLS stable buoyancy production coefficient.' WRITE (out,200) gls_c3p(ng), 'gls_c3p', & & 'GLS unstable buoyancy production coefficient.' WRITE (out,200) gls_sigk(ng), 'gls_sigk', & & 'GLS constant Schmidt number for TKE.' WRITE (out,200) gls_sigp(ng), 'gls_sigp', & & 'GLS constant Schmidt number for PSI.' WRITE (out,140) charnok_alpha(ng), 'charnok_alpha', & & 'Charnok factor for Zos calculation.' WRITE (out,140) zos_hsig_alpha(ng), 'zos_hsig_alpha', & & 'Factor for Zos calculation using Hsig(Awave).' WRITE (out,140) sz_alpha(ng), 'sz_alpha', & & 'Factor for Wave dissipation surface tke flux .' WRITE (out,140) crgban_cw(ng), 'crgban_cw', & & 'Factor for Craig/Banner surface tke flux.' WRITE (out,200) rdrg(ng), 'rdrg', & & 'Linear bottom drag coefficient (m/s).' WRITE (out,200) rdrg2(ng), 'rdrg2', & & 'Quadratic bottom drag coefficient.' WRITE (out,200) Zob(ng), 'Zob', & & 'Bottom roughness (m).' IF (Zob(ng).le.0.0_r8) THEN WRITE (out,260) 'Zob.', & & 'It must be greater than zero when BBL is activated.' exit_flag=5 RETURN END IF WRITE (out,200) Zos(ng), 'Zos', & & 'Surface roughness (m).' WRITE (out,200) blk_ZQ(ng), 'blk_ZQ', & & 'Height (m) of surface air humidity measurement.' IF (blk_ZQ(ng).le.0.0_r8) THEN WRITE (out,260) 'blk_ZQ.', & & 'It must be greater than zero.' exit_flag=5 RETURN END IF WRITE (out,200) blk_ZT(ng), 'blk_ZT', & & 'Height (m) of surface air temperature measurement.' IF (blk_ZT(ng).le.0.0_r8) THEN WRITE (out,260) 'blk_ZT.', & & 'It must be greater than zero.' exit_flag=5 RETURN END IF WRITE (out,200) blk_ZW(ng), 'blk_ZW', & & 'Height (m) of surface winds measurement.' IF (blk_ZW(ng).le.0.0_r8) THEN WRITE (out,260) 'blk_ZW.', & & 'It must be greater than zero.' exit_flag=5 RETURN END IF WRITE (out,200) Dcrit(ng), 'Dcrit', & & 'Minimum depth for wetting and drying (m).' WRITE (out,120) Vtransform(ng), 'Vtransform', & & 'S-coordinate transformation equation.' WRITE (out,120) Vstretching(ng), 'Vstretching', & & 'S-coordinate stretching function.' WRITE (out,200) theta_s(ng), 'theta_s', & & 'S-coordinate surface control parameter.' WRITE (out,200) theta_b(ng), 'theta_b', & & 'S-coordinate bottom control parameter.' WRITE (out,160) Tcline(ng), 'Tcline', & & 'S-coordinate surface/bottom layer width (m) used', & & 'in vertical coordinate stretching.' WRITE (out,140) rho0, 'rho0', & & 'Mean density (kg/m3) for Boussinesq approximation.' WRITE (out,140) dstart, 'dstart', & & 'Time-stamp assigned to model initialization (days).' WRITE (out,140) tide_start, 'tide_start', & & 'Reference time origin for tidal forcing (days).' WRITE (out,150) time_ref, 'time_ref', & & 'Reference time for units attribute (yyyymmdd.dd)' DO itrc=1,NAT+NPT WRITE (out,190) Tnudg(itrc,ng), 'Tnudg', itrc, & & 'Nudging/relaxation time scale (days)', & & 'for tracer ', itrc, TRIM(Vname(1,idTvar(itrc))) END DO WRITE (out,210) Znudg(ng), 'Znudg', & & 'Nudging/relaxation time scale (days)', & & 'for free-surface.' WRITE (out,210) M2nudg(ng), 'M2nudg', & & 'Nudging/relaxation time scale (days)', & & 'for 2D momentum.' WRITE (out,210) M3nudg(ng), 'M3nudg', & & 'Nudging/relaxation time scale (days)', & & 'for 3D momentum.' WRITE (out,210) obcfac(ng), 'obcfac', & & 'Factor between passive and active', & & 'open boundary conditions.' WRITE (out,140) T0(ng), 'T0', & & 'Background potential temperature (C) constant.' WRITE (out,140) S0(ng), 'S0', & & 'Background salinity (PSU) constant.' WRITE (out,160) gamma2(ng), 'gamma2', & & 'Slipperiness variable: free-slip (1.0) or ', & & ' no-slip (-1.0).' DO itrc=1,NAT WRITE (out,185) LtracerSrc(itrc,ng), 'LtracerSrc', itrc, & & 'Processing point sources/Sink on tracer ', itrc, & & TRIM(Vname(1,idTvar(itrc))) END DO IF (Hout(idFsur,ng)) WRITE (out,170) Hout(idFsur,ng), & & 'Hout(idFsur)', & & 'Write out free-surface.' IF (Hout(idUbar,ng)) WRITE (out,170) Hout(idUbar,ng), & & 'Hout(idUbar)', & & 'Write out 2D U-momentum component.' IF (Hout(idVbar,ng)) WRITE (out,170) Hout(idVbar,ng), & & 'Hout(idVbar)', & & 'Write out 2D V-momentum component.' IF (Hout(idUvel,ng)) WRITE (out,170) Hout(idUvel,ng), & & 'Hout(idUvel)', & & 'Write out 3D U-momentum component.' IF (Hout(idVvel,ng)) WRITE (out,170) Hout(idVvel,ng), & & 'Hout(idVvel)', & & 'Write out 3D V-momentum component.' IF (Hout(idWvel,ng)) WRITE (out,170) Hout(idWvel,ng), & & 'Hout(idWvel)', & & 'Write out W-momentum component.' IF (Hout(idOvel,ng)) WRITE (out,170) Hout(idOvel,ng), & & 'Hout(idOvel)', & & 'Write out omega vertical velocity.' DO itrc=1,NAT IF (Hout(idTvar(itrc),ng)) WRITE (out,180) & & Hout(idTvar(itrc),ng), 'Hout(idTvar)', & & 'Write out tracer ', itrc, TRIM(Vname(1,idTvar(itrc))) END DO IF (Hout(idUsms,ng)) WRITE (out,170) Hout(idUsms,ng), & & 'Hout(idUsms)', & & 'Write out surface U-momentum stress.' IF (Hout(idVsms,ng)) WRITE (out,170) Hout(idVsms,ng), & & 'Hout(idVsms)', & & 'Write out surface V-momentum stress.' IF (Hout(idUbms,ng)) WRITE (out,170) Hout(idUbms,ng), & & 'Hout(idUbms)', & & 'Write out bottom U-momentum stress.' IF (Hout(idVbms,ng)) WRITE (out,170) Hout(idVbms,ng), & & 'Hout(idVbms)', & & 'Write out bottom V-momentum stress.' IF (Hout(idUbrs,ng)) WRITE (out,170) Hout(idUbrs,ng), & & 'Hout(idUbrs)', & & 'Write out bottom U-current stress.' IF (Hout(idVbrs,ng)) WRITE (out,170) Hout(idVbrs,ng), & & 'Hout(idVbrs)', & & 'Write out bottom V-current stress.' IF (Hout(idUbws,ng)) WRITE (out,170) Hout(idUbws,ng), & & 'Hout(idUbws)', & & 'Write out wind-induced, bottom U-wave stress.' IF (Hout(idVbws,ng)) WRITE (out,170) Hout(idVbws,ng), & & 'Hout(idVbws)', & & 'Write out wind-induced, bottom V-wave stress.' IF (Hout(idUbcs,ng)) WRITE (out,170) Hout(idUbcs,ng), & & 'Hout(idUbcs)', & & 'Write out max wind + current, bottom U-wave stress.' IF (Hout(idVbcs,ng)) WRITE (out,170) Hout(idVbcs,ng), & & 'Hout(idVbcs)', & & 'Write out max wind + current, bottom V-wave stress.' IF (Hout(idUbot,ng)) WRITE (out,170) Hout(idUbot,ng), & & 'Hout(idUbot)', & & 'Write out bed wave orbital U-velocity.' IF (Hout(idVbot,ng)) WRITE (out,170) Hout(idVbot,ng), & & 'Hout(idVbot)', & & 'Write out bed wave orbital V-velocity.' IF (Hout(idUbur,ng)) WRITE (out,170) Hout(idUbur,ng), & & 'Hout(idUbur)', & & 'Write out bottom U-momentum above bed.' IF (Hout(idVbvr,ng)) WRITE (out,170) Hout(idVbvr,ng), & & 'Hout(idVbvr)', & & 'Write out bottom V-momentum above bed.' IF (Hout(idWamp,ng)) WRITE (out,170) Hout(idWamp,ng), & & 'Hout(idWamp)', & & 'Write out wave height.' IF (Hout(idWlen,ng)) WRITE (out,170) Hout(idWlen,ng), & & 'Hout(idWlen)', & & 'Write out wave length.' IF (Hout(idWdir,ng)) WRITE (out,170) Hout(idWdir,ng), & & 'Hout(idWdir)', & & 'Write out wave direction.' DO itrc=1,MBOTP IF (Hout(idBott(itrc),ng)) WRITE (out,180) & & Hout(idBott(itrc),ng), 'Hout(idBott)', & & 'Write out bottom property ', itrc, & & TRIM(Vname(1,idBott(itrc))) END DO IF (Hout(idTsur(itemp),ng)) WRITE (out,170) & & Hout(idTsur(itemp),ng), 'Hout(idTsur)', & & 'Write out surface net heat flux.' IF (Hout(idTsur(isalt),ng)) WRITE (out,170) & & Hout(idTsur(isalt),ng), 'Hout(idTsur)', & & 'Write out surface net salt flux.' IF (Hout(idSrad,ng)) WRITE (out,170) Hout(idSrad,ng), & & 'Hout(idSrad)', & & 'Write out shortwave radiation flux.' IF (Hout(idLrad,ng)) WRITE (out,170) Hout(idLrad,ng), & & 'Hout(idLrad)', & & 'Write out longwave radiation flux.' IF (Hout(idLhea,ng)) WRITE (out,170) Hout(idLhea,ng), & & 'Hout(idLhea)', & & 'Write out latent heat flux.' IF (Hout(idShea,ng)) WRITE (out,170) Hout(idShea,ng), & & 'Hout(idShea)', & & 'Write out sensible heat flux.' IF (Hout(idDano,ng)) WRITE (out,170) Hout(idDano,ng), & & 'Hout(idDano)', & & 'Write out density anomaly.' IF (Hout(idVvis,ng)) WRITE (out,170) Hout(idVvis,ng), & & 'Hout(idVvis)', & & 'Write out vertical viscosity coefficient.' IF (Hout(idTdif,ng)) WRITE (out,170) Hout(idTdif,ng), & & 'Hout(idTdif)', & & 'Write out vertical T-diffusion coefficient.' IF (Hout(idSdif,ng)) WRITE (out,170) Hout(idSdif,ng), & & 'Hout(idSdif)', & & 'Write out vertical S-diffusion coefficient.' IF (Hout(idMtke,ng)) WRITE (out,170) Hout(idMtke,ng), & & 'Hout(idMtke)', & & 'Write out turbulent kinetic energy.' IF (Hout(idMtls,ng)) WRITE (out,170) Hout(idMtls,ng), & & 'Hout(idMtls)', & & 'Write out turbulent generic length-scale.' ! !----------------------------------------------------------------------- ! Report output/input files and check availability of input files. !----------------------------------------------------------------------- ! WRITE (out,220) WRITE (out,230) ' Output Restart File: ', & & TRIM(RSTname(ng)) IF (LdefHIS(ng)) THEN IF (ndefHIS(ng).eq.0) THEN WRITE (out,230) ' Output History File: ', & & TRIM(HISname(ng)) ELSE Lstr=LEN_TRIM(HISname(ng)) WRITE (out,230) ' Prefix for History Files: ', & & HISname(ng)(1:Lstr-3) END IF END IF WRITE (out,230) ' Output Floats File: ', & & TRIM(FLTname(ng)) fname=GRDname(ng) INQUIRE (FILE=TRIM(fname), EXIST=inhere) IF (.not.inhere) GO TO 30 WRITE (out,230) ' Input Grid File: ', & & TRIM(fname) fname=INIname(ng) INQUIRE (FILE=TRIM(fname), EXIST=inhere) IF (.not.inhere) GO TO 30 WRITE (out,230) ' Input Nonlinear Initial File: ', & & TRIM(fname) DO i=1,nFfiles(ng) fname=FRCname(i,ng) INQUIRE (FILE=TRIM(fname), EXIST=inhere) IF (.not.inhere) GO TO 30 WRITE (out,310) ' Input Forcing File ', i, ': ', & & TRIM(fname) END DO fname=fposnam INQUIRE (FILE=TRIM(fname), EXIST=inhere) IF (.not.inhere) GO TO 30 WRITE (out,230) ' Initial Floats Positions File: ', & & TRIM(fname) fname=varname INQUIRE (FILE=TRIM(fname), EXIST=inhere) IF (.not.inhere) GO TO 30 GO TO 40 30 IF (Master) WRITE (out,270) TRIM(fname) exit_flag=4 RETURN 40 CONTINUE END DO IF (Nuser.gt.0) THEN WRITE (out,230) ' Input/Output USER File: ', & & TRIM(USRname) END IF ! !----------------------------------------------------------------------- ! Report generic USER parameters. !----------------------------------------------------------------------- ! IF (Nuser.gt.0) THEN WRITE (out,240) DO i=1,Nuser WRITE (out,250) user(i), i, i END DO END IF END IF ! !----------------------------------------------------------------------- ! Rescale active tracer parameters !----------------------------------------------------------------------- ! DO ng=1,Ngrids DO itrc=1,NAT+NPT ! ! Take the square root of the biharmonic coefficients so it can ! be applied to each harmonic operator. ! nl_tnu4(itrc,ng)=SQRT(ABS(nl_tnu4(itrc,ng))) ! ! Compute inverse nudging coefficients (1/s) used in various tasks. ! IF (Tnudg(itrc,ng).gt.0.0_r8) THEN Tnudg(itrc,ng)=1.0_r8/(Tnudg(itrc,ng)*86400.0_r8) ELSE Tnudg(itrc,ng)=0.0_r8 END IF END DO END DO 50 FORMAT (/,' READ_PhyPar - Error while processing line: ',/,a) 60 FORMAT (/,1x,a,/, & & /,1x,'Operating system : ',a, & & /,1x,'CPU/hardware : ',a, & & /,1x,'Compiler system : ',a, & & /,1x,'Compiler command : ',a, & & /,1x,'Compiler flags : ',a,/, & & /,1x,'Input Script : ',a,/, & & /,1x,'SVN Root URL : ',a, & & /,1x,'SVN Revision : ',a,/, & & /,1x,'Local Root : ',a, & & /,1x,'Header Dir : ',a, & & /,1x,'Header file : ',a, & & /,1x,'Analytical Dir: ',a) 70 FORMAT (/,' Resolution, Grid ',i2.2,': ',i4.4,'x',i4.4,'x',i3.3, & & ',',2x,'Parallel Nodes: ',i3,',',2x,'Tiling: ',i3.3, & & 'x',i3.3) 80 FORMAT (/,' ROMS/TOMS: Wrong choice of domain ',i2.2,1x, & & 'partition or number of parallel threads.', & & /,12x,'NtileI * NtileJ must be equal to the number of ', & & 'parallel nodes.', & & /,12x,'Change -np value to mpirun or', & & /,12x,'change domain partition in input script.') 90 FORMAT (/,' Resolution, Grid ',i2.2,': ',i4.4,'x',i4.4,'x',i3.3, & & ',',2x,'Parallel Threads: ',i2,',',2x,'Tiling: ',i3.3, & & 'x',i3.3) 100 FORMAT (/,' ROMS/TOMS: Wrong choice of domain ',i3.3,1x, & & 'partition or number of parallel threads.', & & /,12x,'NtileI*NtileJ must be a positive multiple of the', & & ' number of threads.', & & /,12x,'Change number of threads (environment variable) ', & & 'or',/,12x,'change domain partition in input script.') 110 FORMAT (/,/,' Physical Parameters, Grid: ',i2.2, & & /, ' =============================',/) 120 FORMAT (1x,i10,2x,a,t30,a) 130 FORMAT (1x,i10,2x,a,t30,a,/,t32,a) 140 FORMAT (f11.3,2x,a,t30,a) 150 FORMAT (f11.2,2x,a,t30,a) 160 FORMAT (f11.3,2x,a,t30,a,/,t32,a) 170 FORMAT (10x,l1,2x,a,t30,a) 180 FORMAT (10x,l1,2x,a,t30,a,i2.2,':',1x,a) 185 FORMAT (10x,l1,2x,a,'(',i2.2,')',t30,a,i2.2,':',1x,a) 190 FORMAT (1p,e11.4,2x,a,'(',i2.2,')',t30,a,/,t32,a,i2.2,':',1x,a) 195 FORMAT (1p,e11.4,2x,a,t30,a,i2.2,':',1x,a) 200 FORMAT (1p,e11.4,2x,a,t30,a) 210 FORMAT (1p,e11.4,2x,a,t30,a,/,t32,a) 220 FORMAT (/,' Output/Input Files:',/) 230 FORMAT (2x,a,a) 240 FORMAT (/,' Generic User Parameters:',/) 250 FORMAT (1p,e11.4,2x,'user(',i2.2,')',t30, & & 'User parameter ',i2.2,'.') 260 FORMAT (/,' READ_PHYPAR - Invalid input parameter, ',a,/,15x,a) 270 FORMAT (/,' READ_PHYPAR - could not find input file: ',a) 280 FORMAT (/,' READ_PHYPAR - variable info not yet loaded, ', a) 290 FORMAT (/,' READ_PHYPAR - Invalid dimension parameter, ',a,i4, & & /,15x,a) 300 FORMAT (/,' READ_PHYPAR - Invalid dimension parameter, ',a,'(', & & i2.2,')',/,15x,a) 310 FORMAT (2x,a,i2.2,a,a) 320 FORMAT (/,' READ_PHYPAR - Invalid input parameter, ',a,i4,/,15x,a) RETURN END SUBROUTINE read_PhyPar SUBROUTINE read_FloatsPar (model, inp, out, Lwrite) ! !======================================================================= ! ! ! This routine reads in input station parameters. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_floats USE mod_iounits USE mod_ncparam USE mod_scalars ! implicit none ! ! Imported variable declarations ! logical, intent(in) :: Lwrite integer, intent(in) :: model, inp, out ! ! Local variable declarations. ! integer :: Npts, Nval integer :: i, j, igrid, mc, nc, ng, status integer, dimension(Ngrids) :: ncount, nentry integer, allocatable :: Fcoor(:,:), Fcount(:,:), Ftype(:,:) integer :: decode_line, load_i, load_l, load_r real(r8) :: xfloat, yfloat, zfloat real(r8), dimension(100) :: Rval real(r8), allocatable :: Ft0(:,:), Fx0(:,:), Fy0(:,:), Fz0(:,:) real(r8), allocatable :: Fdt(:,:), Fdx(:,:), Fdy(:,:), Fdz(:,:) character (len=35) :: frmt character (len=40) :: KeyWord character (len=160) :: line character (len=160), dimension(100) :: Cval ! !----------------------------------------------------------------------- ! Read in initial float locations. !----------------------------------------------------------------------- ! ! Notice I added one when allocating local scratch arrays to avoid ! out of bounds in some compilers when reading the last blank line ! which signal termination of input data. ! DO WHILE (.TRUE.) READ (inp,'(a)',ERR=20,END=30) line status=decode_line(line, KeyWord, Nval, Cval, Rval) IF (status.gt.0) THEN IF (TRIM(KeyWord).eq.'Lfloats') THEN Npts=load_l(Nval, Cval, Ngrids, Lfloats) ELSE IF (TRIM(KeyWord).eq.'FRREC') THEN Npts=load_i(Nval, Rval, Ngrids, frrec) ELSE IF (TRIM(KeyWord).eq.'NFLOATS') THEN Npts=load_i(Nval, Rval, Ngrids, Nfloats) ELSE IF (TRIM(KeyWord).eq.'POS') THEN Npts=Nfloats(1)+1 IF (Ngrids.gt.1) Npts=MAXVAL(Nfloats)+1 IF (.not.allocated(Fcoor)) allocate ( Fcoor (Npts,Ngrids) ) IF (.not.allocated(Fcount)) allocate ( Fcount(Npts,Ngrids) ) IF (.not.allocated(Ftype)) allocate ( Ftype (Npts,Ngrids) ) IF (.not.allocated(Ft0)) allocate ( Ft0(Npts,Ngrids) ) IF (.not.allocated(Fx0)) allocate ( Fx0(Npts,Ngrids) ) IF (.not.allocated(Fy0)) allocate ( Fy0(Npts,Ngrids) ) IF (.not.allocated(Fz0)) allocate ( Fz0(Npts,Ngrids) ) IF (.not.allocated(Fdt)) allocate ( Fdt(Npts,Ngrids) ) IF (.not.allocated(Fdx)) allocate ( Fdx(Npts,Ngrids) ) IF (.not.allocated(Fdy)) allocate ( Fdy(Npts,Ngrids) ) IF (.not.allocated(Fdz)) allocate ( Fdz(Npts,Ngrids) ) DO ng=1,Ngrids CALL allocate_floats (ng) END DO ncount(1:Ngrids)=0 nentry(1:Ngrids)=0 DO WHILE (.TRUE.) READ (inp,*,ERR=30,END=30) igrid, & & Fcoor (nentry(igrid)+1,igrid), & & Ftype (nentry(igrid)+1,igrid), & & Fcount(nentry(igrid)+1,igrid), & & Ft0(nentry(igrid)+1,igrid), & & Fx0(nentry(igrid)+1,igrid), & & Fy0(nentry(igrid)+1,igrid), & & Fz0(nentry(igrid)+1,igrid), & & Fdt(nentry(igrid)+1,igrid), & & Fdx(nentry(igrid)+1,igrid), & & Fdy(nentry(igrid)+1,igrid), & & Fdz(nentry(igrid)+1,igrid) IF (igrid.gt.Ngrids) THEN IF (Lwrite) WRITE (out,40) fposnam exit_flag=4 RETURN END IF ncount(igrid)=ncount(igrid)+Fcount(nentry(igrid)+1,igrid) nentry(igrid)=nentry(igrid)+1 END DO END IF END IF END DO 20 IF (Master) WRITE (out,50) line exit_flag=4 RETURN 30 CONTINUE ! ! Turn off the processing of floats if not running long enough to ! create a floats file (LdefFLT=.FALSE. because nFLT < ntimes or ! nFLT = 0 when nrrec = 0). ! DO ng=1,Ngrids IF (.not.LdefFLT(ng).and.Lfloats(ng)) THEN Lfloats(ng)=.FALSE. END IF END DO ! !----------------------------------------------------------------------- ! Report input parameters. !----------------------------------------------------------------------- ! IF (Lwrite) THEN DO ng=1,Ngrids IF (Lfloats(ng)) THEN IF (ncount(ng).ne.Nfloats(ng)) THEN WRITE (stdout,60) ncount(ng), Nfloats(ng) exit_flag=4 RETURN END IF WRITE (out,70) ng DO i=1,nentry(ng) IF (.not.spherical.and.(Fcoor(i,ng).eq.0)) THEN frmt='(i1,i2,i5,f10.4,2f8.2,f8.2,4f9.3)' ELSE frmt='(i1,i2,i5,f10.4,3f8.2,4f9.3)' END IF WRITE (out,frmt) Fcoor(i,ng), Ftype(i,ng), Fcount(i,ng), & & Ft0(i,ng), Fx0(i,ng), Fy0(i,ng), & & Fz0(i,ng), Fdt(i,ng), Fdx(i,ng), & & Fdy(i,ng), Fdz(i,ng) END DO WRITE (out,80) Nfloats(ng), & & 'Nfloats', & & 'Number of float trajectories to compute.' END IF END DO END IF ! !----------------------------------------------------------------------- ! Process initial float locations. !----------------------------------------------------------------------- ! ! Set time of float release (seconds after model initialization) and ! initial float horizontal positions (grid units). Fill the initial ! vertical level or depth position. ! DO ng=1,Ngrids mc=0 nc=0 IF (Lfloats(ng)) THEN DO i=1,nentry(ng) IF (Fcount(i,ng).eq.1) THEN nc=nc+1 FLT(ng)%Tinfo(itstr,nc)=(dstart+Ft0(i,ng))*day2sec FLT(ng)%Tinfo(izgrd,nc)=Fz0(i,ng) FLT(ng)%Ftype(nc)=Ftype(i,ng) IF (Fcoor(i,ng).eq.0) THEN FLT(ng)%Tinfo(ixgrd,nc)=MIN(MAX(0.5_r8,Fx0(i,ng)), & & REAL(Lm(ng),r8)+0.5_r8) FLT(ng)%Tinfo(iygrd,nc)=MIN(MAX(0.5_r8,Fy0(i,ng)), & & REAL(Mm(ng),r8)+0.5_r8) ELSE mc=mc+1 FLT(ng)%Flon(mc)=Fx0(i,ng) FLT(ng)%Flat(mc)=Fy0(i,ng) FLT(ng)%Findex(mc)=nc END IF ELSE IF (Fcount(i,ng).gt.1) THEN DO j=1,Fcount(i,ng) nc=nc+1 IF (Fdt(i,ng).gt.0.0_r8) THEN FLT(ng)%Tinfo(itstr,nc)=(dstart+Ft0(i,ng)+ & & REAL(j-1,r8)*Fdt(i,ng))* & & day2sec FLT(ng)%Tinfo(izgrd,nc)=Fz0(i,ng) FLT(ng)%Ftype(nc)=Ftype(i,ng) IF (Fcoor(i,ng).eq.0) THEN FLT(ng)%Tinfo(ixgrd,nc)=MIN(MAX(0.5_r8,Fx0(i,ng)), & & REAL(Lm(ng),r8)+0.5_r8) FLT(ng)%Tinfo(iygrd,nc)=MIN(MAX(0.5_r8,Fy0(i,ng)), & & REAL(Mm(ng),r8)+0.5_r8) ELSE mc=mc+1 FLT(ng)%Flon(mc)=Fx0(i,ng) FLT(ng)%Flat(mc)=Fy0(i,ng) FLT(ng)%Findex(mc)=nc END IF ELSE FLT(ng)%Tinfo(itstr,nc)=(dstart+Ft0(i,ng))*day2sec IF (Fdz(i,ng).eq.0.0_r8) THEN FLT(ng)%Tinfo(izgrd,nc)=Fz0(i,ng) ELSE IF (Fz0(i,ng).gt.0.0_r8) THEN zfloat=Fz0(i,ng)+REAL(j-1,r8)*Fdz(i,ng) FLT(ng)%Tinfo(izgrd,nc)=MIN(MAX(0.0_r8,zfloat), & & REAL(N(ng),r8)) ELSE FLT(ng)%Tinfo(izgrd,nc)=Fz0(i,ng)+ & & REAL(j-1,r8)*Fdz(i,ng) END IF END IF FLT(ng)%Ftype(nc)=Ftype(i,ng) IF (Fcoor(i,ng).eq.0) THEN xfloat=Fx0(i,ng)+REAL(j-1,r8)*Fdx(i,ng) FLT(ng)%Tinfo(ixgrd,nc)=MIN(MAX(0.5_r8,xfloat), & & REAL(Lm(ng),r8)+0.5_r8) yfloat=Fy0(i,ng)+REAL(j-1,r8)*Fdy(i,ng) FLT(ng)%Tinfo(iygrd,nc)=MIN(MAX(0.5_r8,yfloat), & & REAL(Mm(ng),r8)+0.5_r8) ELSE mc=mc+1 FLT(ng)%Flon(mc)=Fx0(i,ng)+REAL(j-1,r8)*Fdx(i,ng) FLT(ng)%Flat(mc)=Fy0(i,ng)+REAL(j-1,r8)*Fdy(i,ng) FLT(ng)%Findex(mc)=nc END IF END IF END DO END IF END DO FLT(ng)%Findex(0)=mc END IF END DO ! ! Deallocate local arrays. ! IF (allocated(Fcoor)) deallocate ( Fcoor ) IF (allocated(Fcount)) deallocate ( Fcount ) IF (allocated(Ftype)) deallocate ( Ftype ) IF (allocated(Ft0)) deallocate ( Ft0 ) IF (allocated(Fx0)) deallocate ( Fx0 ) IF (allocated(Fy0)) deallocate ( Fy0 ) IF (allocated(Fz0)) deallocate ( Fz0 ) IF (allocated(Fdt)) deallocate ( Fdt ) IF (allocated(Fdx)) deallocate ( Fdx ) IF (allocated(Fdy)) deallocate ( Fdy ) IF (allocated(Fdz)) deallocate ( Fdz ) ! 40 FORMAT (/,' READ_FloatsPar - Error while reading floats', & & ' locations in input script: ',a) 50 FORMAT (/,' READ_FloatsPar - Error while processing line: ',/,a) 60 FORMAT (/,' READ_FloatsPar - Inconsistent number of floats to', & & ' process: ', 2i6,/,18x,'change input script.') 70 FORMAT (/,/,' Floats Initial Locations, Grid: ',i2.2, & & /, ' ==================================',/,/, & & 15x,'Ft0',5x,'Fx0',5x,'Fy0',5x,'Fz0', & & 6x,'Fdt',6x,'Fdx',6x,'Fdy',6x,'Fdz',/) 80 FORMAT (/,1x,i10,2x,a,t30,a) RETURN END SUBROUTINE read_FloatsPar FUNCTION decode_line (line_text, KeyWord, Nval, Cval, Rval) ! !======================================================================= ! ! ! This function decodes lines of text from input script files. ! ! ! !======================================================================= ! USE mod_kinds ! implicit none ! ! Imported variable declarations. ! character (len=*), intent(in) :: line_text character (len=40), intent(inout) :: KeyWord integer, intent(inout) :: Nval character (len=160), dimension(100), intent(inout) :: Cval real(r8), dimension(100), intent(inout) :: Rval ! ! Local variable declarations ! logical :: IsString, Kextract, decode, nested integer :: Iblank, Icmm, Kstr, Kend, Linp integer :: Lend, LenS, Lstr, Lval, Nmul, Schar integer :: copies, i, ic, ie, is, j, status integer, dimension(20) :: Imul integer :: decode_line character (len=1 ), parameter :: blank = ' ' character (len=160) :: Vstring, line, string ! !------------------------------------------------------------------------ ! Decode input line. !------------------------------------------------------------------------ ! ! Initialize. ! DO i=1,LEN(line) line(i:i)=blank Vstring(i:i)=blank string(i:i)=blank END DO ! ! Get length of "line", remove leading and trailing blanks. ! line=TRIM(ADJUSTL(line_text)) Linp=LEN_TRIM(line) ! ! If not a blank or comment line [char(33)=!], decode and extract input ! values. Find equal sign [char(61)]. ! status=-1 nested=.FALSE. IF ((Linp.gt.0).and.(line(1:1).ne.CHAR(33))) THEN status=1 Kstr=1 Kend=INDEX(line,CHAR(61),BACK=.FALSE.)-1 Lstr=INDEX(line,CHAR(61),BACK=.TRUE.)+1 ! ! Determine if KEYWORD is followed by double equal sign (==) indicating ! nested parameter. ! IF ((Lstr-Kend).eq.3) nested=.TRUE. ! ! Extract KEYWORD, trim leading and trailing blanks. ! Kextract=.FALSE. IF (Kend.gt.0) THEN Lend=Linp KeyWord=line(Kstr:Kend) Nval=0 Kextract=.TRUE. ELSE Lstr=1 Lend=Linp Kextract=.TRUE. END IF ! ! Extract parameter values string. Remove comments [char(33)=!] or ! continuation symbol [char(92)=\], if any. Trim leading trailing ! blanks. ! IF (Kextract) THEN Icmm=INDEX(line,CHAR(33),BACK=.FALSE.) IF (Icmm.gt.0) Lend=Icmm-1 Icmm=INDEX(line,CHAR(92),BACK=.FALSE.) IF (Icmm.gt.0) Lend=Icmm-1 Vstring=ADJUSTL(line(Lstr:Lend)) Lval=LEN_TRIM(Vstring) ! ! The TITLE KEYWORD is a special one since it can include strings, ! numbers, spaces, and continuation symbol. ! IsString=.FALSE. IF (TRIM(KeyWord).eq.'TITLE') THEN Nval=Nval+1 Cval(Nval)=Vstring(1:Lval) IsString=.TRUE. ELSE ! ! Check if there is a multiplication symbol [char(42)=*] in the variable ! string indicating repetition of input values. ! Nmul=0 DO i=1,Lval IF (Vstring(i:i).eq.CHAR(42)) THEN Nmul=Nmul+1 Imul(Nmul)=i END IF END DO ic=1 ! ! Check for blank spaces [char(32)=' '] between entries and decode. ! is=1 ie=Lval Iblank=0 decode=.FALSE. DO i=1,Lval IF (Vstring(i:i).eq.CHAR(32)) THEN IF (Vstring(i+1:i+1).ne.CHAR(32)) decode=.TRUE. Iblank=i ELSE ie=i ENDIF IF (decode.or.(i.eq.Lval)) THEN Nval=Nval+1 ! ! Processing numeric values. Check starting character to determine ! if numeric or character values. It is possible to have both when ! processing repetitions via the multiplication symbol. ! Schar=ICHAR(Vstring(is:is)) IF (((48.le.Schar).and.(Schar.le.57)).or. & & (Schar.eq.43).or.(Schar.eq.45)) THEN IF ((Nmul.gt.0).and. & & (is.lt.Imul(ic)).and.(Imul(ic).lt.ie)) THEN READ (Vstring(is:Imul(ic)-1),*) copies Schar=ICHAR(Vstring(Imul(ic)+1:Imul(ic)+1)) IF ((43.le.Schar).and.(Schar.le.57)) THEN READ (Vstring(Imul(ic)+1:ie),*) Rval(Nval) DO j=1,copies-1 Rval(Nval+j)=Rval(Nval) END DO ELSE string=Vstring(Imul(ic)+1:ie) LenS=LEN_TRIM(string) Cval(Nval)=string(1:LenS) DO j=1,copies-1 Cval(Nval+j)=Cval(Nval) END DO END IF Nval=Nval+copies-1 ic=ic+1 ELSE string=Vstring(is:ie) LenS=LEN_TRIM(string) READ (string(1:LenS),*) Rval(Nval) END IF ELSE ! ! Processing character values (logicals and strings). ! IF ((Nmul.gt.0).and. & & (is.lt.Imul(ic)).and.(Imul(ic).lt.ie)) THEN READ (Vstring(is:Imul(ic)-1),*) copies Cval(Nval)=Vstring(Imul(ic)+1:ie) DO j=1,copies-1 Cval(Nval+j)=Cval(Nval) END DO Nval=Nval+copies-1 ic=ic+1 ELSE string=Vstring(is:ie) Cval(Nval)=TRIM(ADJUSTL(string)) END IF IsString=.TRUE. END IF is=Iblank+1 ie=Lval decode=.FALSE. END IF END DO END IF END IF status=Nval END IF decode_line=status RETURN END FUNCTION decode_line FUNCTION load_i (Ninp, Vinp, Nout, Vout) ! !======================================================================= ! ! ! This function loads input values into a requested model integer ! ! variable. ! ! ! ! On Input: ! ! ! ! Ninp Size of input variable. ! ! Vinp Input values ! ! Nout Number of output values. ! ! ! ! On Output: ! ! ! ! Vout Output integer variable. ! ! load_i Number of output values processed. ! ! ! !======================================================================= ! USE mod_kinds ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: Ninp, Nout real(r8), intent(in) :: Vinp(Ninp) integer, intent(out) :: Vout(Nout) ! ! Local variable declarations. ! integer :: i, ic integer :: load_i ! !----------------------------------------------------------------------- ! Load integer variable with input values. !----------------------------------------------------------------------- ! ! If not all values are provided for variable, assume the last value ! for the rest of the array. ! ic=0 IF (Ninp.le.Nout) THEN DO i=1,Ninp ic=ic+1 Vout(i)=INT(Vinp(i)) END DO DO i=Ninp+1,Nout ic=ic+1 Vout(i)=INT(Vinp(Ninp)) END DO ELSE DO i=1,Nout ic=ic+1 Vout(i)=INT(Vinp(i)) END DO END IF load_i=ic RETURN END FUNCTION load_i FUNCTION load_l (Ninp, Vinp, Nout, Vout) ! !======================================================================= ! ! ! This function loads input values into a requested model logical ! ! variable. ! ! ! ! On Input: ! ! ! ! Ninp Size of input variable. ! ! Vinp Input values ! ! Nout Number of output values. ! ! ! ! On Output: ! ! ! ! Vout Output integer variable. ! ! load_l Number of output values processed. ! ! ! !======================================================================= ! USE mod_kinds ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: Ninp, Nout character (len=*), intent(in) :: Vinp(Ninp) logical, intent(out) :: Vout(Nout) ! ! Local variable declarations. ! integer :: i, ic integer :: load_l ! !----------------------------------------------------------------------- ! Load integer variable with input values. !----------------------------------------------------------------------- ! ! If not all values are provided for variable, assume the last value ! for the rest of the array. ! ic=0 IF (Ninp.le.Nout) THEN DO i=1,Ninp ic=ic+1 IF ((Vinp(i)(1:1).eq.'T').or.(Vinp(i)(1:1).eq.'t')) THEN Vout(i)=.TRUE. ELSE Vout(i)=.FALSE. END IF END DO DO i=Ninp+1,Nout ic=ic+1 IF ((Vinp(Ninp)(1:1).eq.'T').or.(Vinp(Ninp)(1:1).eq.'t')) THEN Vout(i)=.TRUE. ELSE Vout(i)=.FALSE. END IF END DO ELSE DO i=1,Nout ic=ic+1 IF ((Vinp(i)(1:1).eq.'T').or.(Vinp(i)(1:1).eq.'t')) THEN Vout(i)=.TRUE. ELSE Vout(i)=.FALSE. END IF END DO END IF load_l=ic RETURN END FUNCTION load_l FUNCTION load_r (Ninp, Vinp, Nout, Vout) ! !======================================================================= ! ! ! This function loads input values into a requested model real ! ! variable. ! ! ! ! On Input: ! ! ! ! Ninp Size of input variable. ! ! Vinp Input values ! ! Nout Number of output values. ! ! ! ! On Output: ! ! ! ! Vout Output real variable. ! ! load_r Number of output values processed. ! ! ! !======================================================================= ! USE mod_kinds ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: Ninp, Nout real(r8), intent(in) :: Vinp(Ninp) real(r8), intent(out) :: Vout(Nout) ! ! Local variable declarations. ! integer :: i, ic integer :: load_r ! !----------------------------------------------------------------------- ! Load integer variable with input values. !----------------------------------------------------------------------- ! ! If not all values are provided for variable, assume the last value ! for the rest of the array. ! ic=0 IF (Ninp.le.Nout) THEN DO i=1,Ninp ic=ic+1 Vout(i)=Vinp(i) END DO DO i=Ninp+1,Nout ic=ic+1 Vout(i)=Vinp(Ninp) END DO ELSE DO i=1,Nout ic=ic+1 Vout(i)=Vinp(i) END DO END IF load_r=ic RETURN END FUNCTION load_r