copyright (C) 2001 MSC-RPN COMM %%%MC2%%%subroutine mod_rstrt (unrstrt,prout,status,caller) 3,1 implicit none * character* (*) caller logical prout integer unrstrt,status * * ########################################## * # Modification of a limited number of # * # controle parameters at restart # * ########################################## * #include "mc2nml.cdk"
#include "path.cdk"
* character*10 nmlname integer unnml,pnerrdirf,pnflag1,pnflag2,k,longueur data unnml /11/ * *--------------------------------------------------------------------- * status = -1 nmlname = 'restart' * * *** Updating configuration with namelist restart * open (unnml,file=nml,access='SEQUENTIAL', $ form='FORMATTED',status='OLD',iostat=pnerrdirf) if (pnerrdirf.ne.0) then status = 1 goto 9991 endif * call checnml
(unnml,'&'//nmlname,pnflag1) if (pnflag1.eq.0) then * #if defined (NEC) read (unnml,restart,iostat=pnflag2) #else read (unnml,nml=restart,iostat=pnflag2) #endif if (pnflag2.ne.0) then print '(/,2x,a/2x,4a/)', '==> ABORT -- ABORT <==', $ 'PROBLEM WITH NAMELIST ',nmlname,' ON FILE ', $ nml(1:longueur(nml)) goto 9991 else print *, ' CONFIGURATION UPDATED WITH NAMELIST ',nmlname endif else status = 1 goto 9991 endif * close (unnml) * gnnrstrt = min(gnnt,gnnrstrt) if (gnnrstrt.lt.1) gnnrstrt = gnnt gndstat = max(1,gndstat) gnpstat = max(1,gnpstat) * * Print controle parameters * if (prout) then if (caller.eq."PIL") then print '(4x,a/16x,a)', $ 'WARNING -- POSSIBLE RESTART MODIFICATION', $ 'FOR VARIABLE: gnnrstrt,npilf' else if (caller.eq."MC2") then print '(4x,a/16x,a/16x,a)', $ 'WARNING -- POSSIBLE RESTART MODIFICATION', $ 'FOR VARIABLE: gnnrstrt,gndstat,gnpstat,gnstatdp,diagres' endif endif * status = 1 9991 continue * *--------------------------------------------------------------------- * return end