copyright (C) 2001 MSC-RPN COMM %%%MC2%%% *subroutine out_ctrl (status) 1 implicit none * integer status * * ########################################## * # Initialization of controle parameters # * # (see MC2 user guide for descriptions) # * ########################################## * #include "mc2nml.cdk"
character*256 path character*32 dumc character*10 nmlname character*1 nfe integer i,k,unnml,pnerrdirf,pnflag1,pnflag2,len,nfe_nsec,longueur data unnml /11/ * *--------------------------------------------------------------------- * status = -1 * call getenvc('rep_from_which_model_is_launched',path) path = path(1:longueur(path))//'/process/model_settings' * gtetikt = 'MC2_V4.9.6' datyp = 5 nbit = 16 out_unit_S = 'P' rndoseq = 'RND' v_interp = 'CUBIC_UQAM' gnip3 = -1 out_staguv = .true. nstepsor_d = gnnt nstepsor_p = gnnt * * *** Updating configuration with namelist sor_cfgs * open (unnml,file=path,access='SEQUENTIAL', $ form='FORMATTED',status='OLD',iostat=pnerrdirf) if (pnerrdirf.ne.0) then print '(/,2x,a/2x,3a/)', '==> ABORT -- ABORT <==', $ 'FILE ',path(1:longueur(path)),' NOT FOUND' goto 9991 endif * nmlname = 'sor_cfgs' rewind ( unnml ) read (unnml, nml=sor_cfgs, end = 9120) write (6,601) nmlname * close (unnml) * call low2up (out_unit_S ,dumc) out_unit_S = dumc if (nbit.ne.32) datyp = 1 call low2up (rndoseq,dumc) rndoseq = dumc call low2up (v_interp,dumc) v_interp = dumc do i=1,nkout call low2up (udolist(i),dumc) udolist(i) = dumc end do nstepsor_d = max(1,nstepsor_d) nstepsor_p = max(1,nstepsor_p) * print* write (6, nml=sor_cfgs_print) print* * Grdc_ndt = -1 len=longueur(grdc_nfe) if (len.gt.0) then call low2up (grdc_nfe(len:len),nfe) nfe_nsec = 3600 if (nfe.eq.'D') nfe_nsec = 86400 if (nfe.eq.'M') nfe_nsec = 60 if (nfe.eq.'S') nfe_nsec = 1 if ((nfe.eq.'D').or.(nfe.eq.'H').or. $ (nfe.eq.'M').or.(nfe.eq.'S')) len= len-1 read ( grdc_nfe(1:len), * ) Grdc_ndt Grdc_ndt = Grdc_ndt * nfe_nsec / nint(grdt) endif Grdc_nsor = Grdc_ndt * status = 1 goto 9991 9120 write (6, 9150) nmlname,path 9991 continue * 601 format (' CONFIGURATION UPDATED WITH NAMELIST ',a) 9150 format (/,2x,'==> ABORT -- ABORT <=='/2x,'NAMELIST ',a, $ ' NOT FOUND ON FILE ',a/) *--------------------------------------------------------------------- * return end