| PUMA 219 Portable University Model of the Atmosphere

- Main Page
- Data Types List
- Files

- File List
- File Members

/Users/home/WC/puma/src/restartmod.f90
Go to the documentation of this file.

    00001       module restartmod
    00002       integer, parameter :: nresdim  = 200   ! Max number of records
    00003       integer, parameter :: nreaunit =  33   ! FORTRAN unit for reading
    00004       integer, parameter :: nwriunit =  34   ! FORTRAN unit for writing
    00005       integer            :: nexcheck =   1   ! Extended checks
    00006       integer            :: nresnum  =   0   ! Actual number of records
    00007       integer            :: nlastrec =   0   ! Last read record
    00008       integer            :: nud      =   6   ! Standard output
    00009       character (len=16) :: yresnam(nresdim) ! Array of record names
    00010       end module restartmod
    00011
    00012 !     ======================
    00013 !     SUBROUTINE RESTART_INI
    00014 !     ======================
    00015
    00016       subroutine restart_ini(lrestart,yrfile)
    00017       use restartmod
    00018
    00019       logical :: lrestart
    00020       character (len=*)  :: yrfile
    00021       character (len=16) :: yn ! variable name
    00022
    00023       inquire(file=yrfile,exist=lrestart)
    00024       if (lrestart) then
    00025          open(nreaunit,file=yrfile,form='unformatted')
    00026          do
    00027             read (nreaunit,IOSTAT=iostat) yn
    00028             if (iostat /= 0) exit
    00029             nresnum = nresnum + 1
    00030             yresnam(nresnum) = yn
    00031             read (nreaunit,IOSTAT=iostat)
    00032             if (iostat /= 0) exit
    00033             if (nresnum >= nresdim) then
    00034                write(nud,*) 'Too many variables in restart file'
    00035                write(nud,*) 'Increase NRESDIM in module restartmod'
    00036                write(nud,*) '*** Error Stop ***'
    00037                stop
    00038             endif
    00039          enddo
    00040
    00041          write(nud,'(a,i4,3a/)') 'Found ',nresnum, &
    00042                ' variables in file <',trim(yrfile),'>'
    00043          do j = 1 , nresnum
    00044             write(nud,'(i4," : ",8x,1x,a)') j,yresnam(j)
    00045          enddo
    00046          nlastrec = nresnum
    00047       endif ! (lrestart)
    00048
    00049 !     file must be left open for further access
    00050
    00051       return
    00052       end subroutine restart_ini
    00053
    00054
    00055 !     ==========================
    00056 !     SUBROUTINE RESTART_PREPARE
    00057 !     ==========================
    00058
    00059       subroutine restart_prepare(ywfile)
    00060       use restartmod
    00061
    00062       character (len=*) :: ywfile
    00063
    00064       open(nwriunit,file=ywfile,form='unformatted')
    00065
    00066       return
    00067       end subroutine restart_prepare
    00068
    00069
    00070 !     =======================
    00071 !     SUBROUTINE RESTART_STOP
    00072 !     =======================
    00073
    00074       subroutine restart_stop
    00075       use restartmod
    00076
    00077       close (nreaunit)
    00078       close (nwriunit)
    00079
    00080       return
    00081       end subroutine restart_stop
    00082
    00083
    00084 !     ==============================
    00085 !     SUBROUTINE GET_RESTART_INTEGER
    00086 !     ==============================
    00087
    00088       subroutine get_restart_integer(yn,kv)
    00089       use restartmod
    00090
    00091       character (len=*) :: yn
    00092       integer :: kv
    00093
    00094       do j = 1 , nresnum
    00095          if (trim(yn) == trim(yresnam(j))) then
    00096             call fileseek(yn,j)
    00097             read (nreaunit) kv
    00098             nlastrec = nlastrec + 1
    00099             return
    00100          endif
    00101       enddo
    00102       if (nexcheck == 1) then
    00103          write(nud,*) '*** Error in get_restart_integer ***'
    00104          write(nud,*) 'Requested integer {',yn,'} was not found'
    00105          stop
    00106       endif
    00107       return
    00108       end subroutine get_restart_integer
    00109
    00110
    00111 !     ============================
    00112 !     SUBROUTINE GET_RESTART_ARRAY
    00113 !     ============================
    00114
    00115       subroutine get_restart_array(yn,pa,k1,k2,k3)
    00116       use restartmod
    00117
    00118       character (len=*) :: yn
    00119       real :: pa(k2,k3)
    00120
    00121       do j = 1 , nresnum
    00122          if (trim(yn) == trim(yresnam(j))) then
    00123             call fileseek(yn,j)
    00124             read (nreaunit) pa(1:k1,:)
    00125             nlastrec = nlastrec + 1
    00126             return
    00127          endif
    00128       enddo
    00129       if (nexcheck == 1) then
    00130          write(nud,*) '*** Error in get_restart_array ***'
    00131          write(nud,*) 'Requested array {',yn,'} was not found'
    00132          stop
    00133       endif
    00134       return
    00135       end subroutine get_restart_array
    00136
    00137
    00138 !     ==============================
    00139 !     SUBROUTINE PUT_RESTART_INTEGER
    00140 !     ==============================
    00141
    00142       subroutine put_restart_integer(yn,kv)
    00143       use restartmod
    00144
    00145       character (len=*)  :: yn
    00146       character (len=16) :: yy
    00147       integer :: kv
    00148
    00149       yy = yn
    00150       write(nwriunit) yy
    00151       write(nwriunit) kv
    00152       return
    00153       end subroutine put_restart_integer
    00154
    00155
    00156 !     ============================
    00157 !     SUBROUTINE PUT_RESTART_ARRAY
    00158 !     ============================
    00159
    00160       subroutine put_restart_array(yn,pa,k1,k2,k3)
    00161       use restartmod
    00162
    00163       character (len=*)  :: yn
    00164       character (len=16) :: yy
    00165       integer :: k1,k2,k3
    00166       real :: pa(k2,k3)
    00167
    00168       yy = yn
    00169       write(nwriunit) yy
    00170       write(nwriunit) pa(1:k1,1:k3)
    00171       return
    00172       end subroutine put_restart_array
    00173
    00174
    00175 !     ===================
    00176 !     SUBROUTINE FILESEEK
    00177 !     ===================
    00178
    00179       subroutine fileseek(yn,k)
    00180       use restartmod
    00181
    00182       character (len=*)  :: yn
    00183       character (len=16) :: yy
    00184
    00185 !     write(nud,*) 'Pos:',nlastrec,'   Want:',k
    00186       if (k <= nlastrec) then
    00187 !        write(nud,*) 'Rewinding'
    00188          rewind nreaunit
    00189          nlastrec = 0
    00190       endif
    00191
    00192       do
    00193          read (nreaunit,iostat=iostat) yy
    00194          if (iostat /= 0) exit
    00195          if (trim(yn) == trim(yy)) return ! success
    00196          read (nreaunit,iostat=iostat)    ! skip data
    00197          if (iostat /= 0) exit
    00198          nlastrec = nlastrec + 1
    00199       enddo
    00200       write(nud,*) 'Variable <',trim(yn),'> not in restart file'
    00201       return
    00202       end
    00203
    00204
    00205 !     =========================
    00206 !     SUBROUTINE CHECK_EQUALITY
    00207 !     =========================
    00208
    00209       subroutine check_equality(yn,pa,pb,k1,k2)
    00210       character (len=*) :: yn
    00211       real :: pa(k1,k2)
    00212       real :: pb(k1,k2)
    00213
    00214       do j2 = 1 , k2
    00215       do j1 = 1 , k1
    00216          if (pa(j1,j2) /= pb(j1,j2)) then
    00217             write(nud,*) 'No Equality on ',yn,'(',j1,',',j2,')',pa(j1,j2),pb(j1,j2)
    00218             return
    00219          endif
    00220       enddo
    00221       enddo
    00222       write(nud,*) 'Array {',yn,'} is OK'
    00223       return
    00224       end
    00225
    00226
    00227 !     ==================
    00228 !     SUBROUTINE VARSEEK
    00229 !     ==================
    00230
    00231       subroutine varseek(yn,knum)
    00232       use restartmod
    00233
    00234       character (len=*)  :: yn
    00235       character (len=16) :: ytmp
    00236       integer :: k, knum
    00237
    00238       knum = 0
    00239       do k = 1,nresdim
    00240          ytmp = yresnam(k)
    00241          if (trim(yn) == trim(ytmp)) then
    00242             knum = k
    00243          endif
    00244       enddo
    00245       return
    00246       end