Changeset 10 for branches/flexpart91_hasod/src_parallel/readoutgrid.f90

Timestamp:

Aug 15, 2013, 3:23:48 PM (11 years ago)

Author:

hasod

Message:

ADD: namelist input implemented for all common input files

File:

• branches/flexpart91_hasod/src_parallel/readoutgrid.f90 (modified) (5 diffs)

branches/flexpart91_hasod/src_parallel/readoutgrid.f90

@@ -53 +53 @@
   real,parameter :: eps=1.e-4
 
-
+  ! namelist variables
+  integer, parameter :: maxoutlev=500
+  real :: outheights(maxoutlev)
+  integer :: readerror
+
+  ! declare namelist
+  namelist /outgrid/ &
+    outlon0,outlat0, &
+    numxgrid,numygrid, &
+    dxout,dyout, &
+    outheights
+
+  ! helps identifying failed namelist input
+  dxout=-1.0
+  outheights=-1.0
 
   ! Open the OUTGRID file and read output grid specifications
@@ -61 +75 @@
        err=999)
 
-
-  call skplin(5,unitoutgrid)
-
-
-  ! 1.  Read horizontal grid specifications
-  !****************************************
-
-  call skplin(3,unitoutgrid)
-  read(unitoutgrid,'(4x,f11.4)') outlon0
-  call skplin(3,unitoutgrid)
-  read(unitoutgrid,'(4x,f11.4)') outlat0
-  call skplin(3,unitoutgrid)
-  read(unitoutgrid,'(4x,i5)') numxgrid
-  call skplin(3,unitoutgrid)
-  read(unitoutgrid,'(4x,i5)') numygrid
-  call skplin(3,unitoutgrid)
-  read(unitoutgrid,'(4x,f12.5)') dxout
-  call skplin(3,unitoutgrid)
-  read(unitoutgrid,'(4x,f12.5)') dyout
-
+  ! try namelist input
+  read(unitoutgrid,outgrid,iostat=readerror)
+
+
+  if ((dxout.le.0).or.(readerror.ne.0)) then
+
+    readerror=1
+
+    rewind(unitoutgrid)
+    call skplin(5,unitoutgrid)
+
+    ! 1.  Read horizontal grid specifications
+    !****************************************
+
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f11.4)') outlon0
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f11.4)') outlat0
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,i5)') numxgrid
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,i5)') numygrid
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f12.5)') dxout
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f12.5)') dyout
+
+  endif
 
   ! Check validity of output grid (shall be within model domain)
@@ -102 +124 @@
   ! 2. Count Vertical levels of output grid
   !****************************************
-  j=0
-100   j=j+1
+
+  if (readerror.ne.0) then
+    j=0
+100 j=j+1
     do i=1,3
       read(unitoutgrid,*,end=99)
@@ -110 +134 @@
     if (outhelp.eq.0.) goto 99
     goto 100
-99   numzgrid=j-1
-
-    allocate(outheight(numzgrid) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
-    allocate(outheighthalf(numzgrid) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
-
-
-  rewind(unitoutgrid)
-  call skplin(29,unitoutgrid)
+99  numzgrid=j-1
+  else
+    do i=1,maxoutlev
+      if (outheights(i).lt.0) exit
+    end do
+    numzgrid=i-1
+  end if
+
+  allocate(outheight(numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheight'
+  allocate(outheighthalf(numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheighthalf'
 
   ! 2. Vertical levels of output grid
   !**********************************
 
-  j=0
-1000   j=j+1
-    do i=1,3
-      read(unitoutgrid,*,end=990)
-    end do
-    read(unitoutgrid,'(4x,f7.1)',end=990) outhelp
-    if (outhelp.eq.0.) goto 99
-    outheight(j)=outhelp
-    goto 1000
-990   numzgrid=j-1
-
+  if (readerror.ne.0) then
+
+    rewind(unitoutgrid)
+    call skplin(29,unitoutgrid)
+
+    do j=1,numzgrid
+      do i=1,3
+        read(unitoutgrid,*)
+      end do
+      read(unitoutgrid,'(4x,f7.1)') outhelp
+      outheight(j)=outhelp
+    end do
+
+  else
+
+    do j=1,numzgrid
+      outheight(j)=outheights(j)
+    end do
+
+  endif
+
+  close(unitoutgrid)
 
   ! Check whether vertical levels are specified in ascending order
@@ -158 +193 @@
   end do
 
-
   xoutshift=xlon0-outlon0
   youtshift=ylat0-outlat0
-  close(unitoutgrid)
-
-    allocate(oroout(0:numxgrid-1,0:numygrid-1) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
-    allocate(area(0:numxgrid-1,0:numygrid-1) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
-    allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
-    allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
-    allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid) &
-         ,stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+
+  allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate oroout'
+  allocate(area(0:numxgrid-1,0:numygrid-1),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate area'
+  allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate volume'
+  allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate areaeast'
+  allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate areanorth'
   return
 
 
-999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
+999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
   write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
   write(*,*) ' #### xxx/flexpart/options                    #### '