Merge pull request #63 from TimMarchok-NOAA/fix_alloc_array_and_unit_nums

Fix allocatable arrays and allow EMC unit numbers

Author: TimMarchok-NOAA

code/src/support/tave/tave.f

@@ -1070,16 +1070,29 @@ subroutine open_grib_files (lugb,lugi,lout,gribver,iret)
 
       implicit none
 
-      character fnameg*7,fnamei*7,fnameo*7
+      character fnameg*255,fnamei*255,fnameo*255
+      character enameb*16,enamei*16,enameo*16
+      character lugb_c*16,lugi_c*16,lout_c*16
       integer   iret,gribver,lugb,lugi,lout,igoret,iioret,iooret
 
       iret=0
-      fnameg(1:5) = "fort."
-      fnamei(1:5) = "fort."
-      fnameo(1:5) = "fort."
-      write(fnameg(6:7),'(I2)') lugb
-      write(fnamei(6:7),'(I2)') lugi
-      write(fnameo(6:7),'(I2)') lout
+      write(lugb_c,'(I2.2)')lugb
+      write(lugi_c,'(I2.2)')lugi
+      write(lout_c,'(I2.2)')lout
+      enameb='FORT'//lugb_c
+      enamei='FORT'//lugi_c
+      enameo='FORT'//lout_c
+      call get_environment_variable(trim(enameb), fnameg, status=igoret)
+      call get_environment_variable(trim(enamei), fnamei, status=iioret)
+      call get_environment_variable(trim(enameo), fnameo, status=iooret)
+      if (igoret /= 0 .or. iioret /= 0 .or. iooret /= 0) then
+        fnameg(1:5) = "fort."
+        fnamei(1:5) = "fort."
+        fnameo(1:5) = "fort."
+        write(fnameg(6:7),'(I2)') lugb
+        write(fnamei(6:7),'(I2)') lugi
+        write(fnameo(6:7),'(I2)') lout
+      endif
       call baopenr (lugb,fnameg,igoret)
       call baopenr (lugi,fnamei,iioret)
       call baopenw (lout,fnameo,iooret)

code/src/support/vint/vint.f

@@ -956,18 +956,18 @@ subroutine output_data (lout,kf,kpds,kgds,holdgfld,xoutdat
       real     coordlist
       real     xoutdat(kf,nlevsout),xoutlevs_p(nlevsout)
 c
-      iodret=0
-      call baopenw (lout,"fort.51",igoret)
-      print *,'baopenw: igoret= ',igoret
-
-      if (igoret /= 0) then
-        print *,' '
-        print *,'!!! ERROR in vint in sub output_data opening'
-        print *,'!!! **OUTPUT** grib file.  baopenw return codes:'
-        print *,'!!! grib file 1 return code = igoret = ',igoret
-        STOP 95
-        return
-      endif
+c      iodret=0
+c      call baopenw (lout,"fort.51",igoret)
+c      print *,'baopenw: igoret= ',igoret
+
+c      if (igoret /= 0) then
+c        print *,' '
+c        print *,'!!! ERROR in vint in sub output_data opening'
+c        print *,'!!! **OUTPUT** grib file.  baopenw return codes:'
+c        print *,'!!! grib file 1 return code = igoret = ',igoret
+c        STOP 95
+c        return
+c      endif
 
       levloop: do lev = 1,nlevsout
 
@@ -1209,16 +1209,29 @@ subroutine open_grib_files (lugb,lugi,lout,gribver,iret)
 
       implicit none
 
-      character fnameg*7,fnamei*7,fnameo*7
+      character(2)   lugb_c,lugi_c,lout_c
+      character(255) fnameg,fnamei,fnameo
+      character(6)   enameb,enamei,enameo
       integer   iret,gribver,lugb,lugi,lout,igoret,iioret,iooret
 
       iret=0
-      fnameg(1:5) = "fort."
-      fnamei(1:5) = "fort."
-      fnameo(1:5) = "fort."
-      write(fnameg(6:7),'(I2)') lugb
-      write(fnamei(6:7),'(I2)') lugi
-      write(fnameo(6:7),'(I2)') lout
+      write(lugb_c,'(i2)')lugb
+      write(lugi_c,'(i2)')lugi
+      write(lout_c,'(i2)')lout
+      enameb='FORT'//adjustl(lugb_c)
+      enamei='FORT'//adjustl(lugi_c)
+      enameo='FORT'//adjustl(lout_c)
+      call get_environment_variable(enameb,fnameg, status=igoret)
+      call get_environment_variable(enamei, fnamei, status=iioret)
+      call get_environment_variable(enameo, fnameo, status=iooret)
+      if (igoret /= 0 .or. iioret /= 0 .or. iooret /= 0) then
+        fnameg(1:5) = "fort."
+        fnamei(1:5) = "fort."
+        fnameo(1:5) = "fort."
+        write(fnameg(6:7),'(I2)') lugb
+        write(fnamei(6:7),'(I2)') lugi
+        write(fnameo(6:7),'(I2)') lout
+      endif
       call baopenr (lugb,fnameg,igoret)
       call baopenr (lugi,fnamei,iioret)
       call baopenw (lout,fnameo,iooret)

code/src/tracker/gettrk_subroutines.f

@@ -883,12 +883,18 @@ subroutine tracker (inp,maxstorm,numtcv,ifhmax,trkrinfo,ncfile
         v     = -9999.0
         slp   = -9999.0 
         tmean = -9999.0
-        sst   = -9999.0
-        q850  = -9999.0
-        rh    = -9999.0 
-        spfh  = -9999.0
-        temperature  = -9999.0
-        omega500  = -9999.0
+
+        if (sstflag == 'y' .or. sstflag == 'Y') then
+          sst   = -9999.0
+        endif
+
+        if (genflag == 'y' .or. genflag == 'Y') then
+          q850  = -9999.0
+          rh    = -9999.0 
+          spfh  = -9999.0
+          temperature  = -9999.0
+          omega500  = -9999.0
+        endif
 
         readflag    = .FALSE.
         readgenflag = .FALSE.
@@ -4337,7 +4343,9 @@ subroutine open_grib_files (inp,lugb,lugi,gfilename,ifilename
       logical(1)  output_file_open
       logical(1)  file_open
       logical(4)  file_open4,file_open5
-      character fnameg*7,fnamei*7,fnameo*7
+      character fnameg*255,fnamei*255,fnameo*255
+      character enameb*16,enamei*16,enameo*16
+      character lugb_c*16,lugi_c*16,lout_c*16
       character fname_mask_g*7,fname_mask_i*7
       character opening_mask*1
       character(*) gfilename,ifilename
@@ -4351,20 +4359,41 @@ subroutine open_grib_files (inp,lugb,lugi,gfilename,ifilename
       iooret = 0
 
       if (inp%file_seq == 'onebig') then
-        fnameg(1:5) = "fort."
-        fnamei(1:5) = "fort."
-        write(fnameg(6:7),'(I2)') lugb
-        write(fnamei(6:7),'(I2)') lugi
+
+        write(lugb_c,'(I2.2)')lugb
+        write(lugi_c,'(I2.2)')lugi
+        enameb='FORT'//lugb_c
+        enamei='FORT'//lugi_c
+        call get_environment_variable(trim(enameb), fnameg
+     &          , status=igoret)
+        call get_environment_variable(trim(enamei), fnamei
+     &          , status=iioret)
+
+        if (igoret /= 0 .or. iioret /= 0) then
+          fnameg(1:5) = "fort."
+          fnamei(1:5) = "fort."
+          write(fnameg(6:7),'(I2)') lugb
+          write(fnamei(6:7),'(I2)') lugi
+        endif
+
         call baopenr (lugb,fnameg,igoret)
         call baopenr (lugi,fnamei,iioret)
+
         if (opening_mask /= 'y') then
           ! If this is a regular call to open_grib_files (i.e., not
           ! for opening the land-sea mask file), then open the 
           ! output grib file unit.
-          fnameo(1:5) = "fort."
-          write(fnameo(6:7),'(I2)') lout
-          call baopenw (lout,fnameo,iooret)
+          write(lout_c,'(I2.2)')lout
+          enameo='FORT'//lout_c
+          call get_environment_variable(trim(enameo), fnameo
+     &            , status=iooret)
+          if (iooret /= 0) then
+            fnameo(1:5) = "fort."
+            write(fnameo(6:7),'(I2)') lout
+            call baopenw (lout,fnameo,iooret)
+          endif
         endif
+
       else
 
         if (opening_mask == 'y') then
@@ -4375,7 +4404,9 @@ subroutine open_grib_files (inp,lugb,lugi,gfilename,ifilename
           print *,'!!! inp%file_seq flag indicates that this is not'
           print *,'!!! a onebig file, and as of yet, the functionality'
           print *,'!!! for an additional land-sea mask file can only'
-          print *,'!!! be used for onebig file applications.'
+          print *,'!!! be used for onebig file applications.  As an'
+          print *,'!!! alternative, you can include a land-sea mask'
+          print *,'!!! record within each individual file.'
           stop 95
         endif
 
@@ -4413,7 +4444,7 @@ subroutine open_grib_files (inp,lugb,lugi,gfilename,ifilename
       inquire (unit=lugb, opened=file_open)
       if (file_open) then
         print *,'TEST open_grib_files, unit lugb= ',lugb
-     &        ,' is OPEN'
+     &         ,' is OPEN'
       else
         print *,'TEST open_grib_files, unit lugb= ',lugb
      &         ,' is CLOSED'
@@ -4476,6 +4507,7 @@ subroutine open_grib_files (inp,lugb,lugi,gfilename,ifilename
 
         iret = 113
         return
+
       endif
 
       return
@@ -12979,8 +13011,8 @@ subroutine output_atcf_gen (outlon,outlat,inp,ist
      &       ,'_',a3,', ',i10.10,', 03, ',a4,', ',i3.3,', ',i3,a1
      &       ,', ',i4,a1,', ',i3,', ',i4,', ',a12,4(', ',i4.4)
      &       ,', ',3(i4,', '),3(i6,', '),a1,2(', ',i4),4(', ',i6)
-     &       ,', SHR82, ',i4,', ',i3,', ',i5,3(', ',i4),2(', ',i9)
-     &       ,3(', ',i4))
+     &       ,', SHR82, ',i4,', ',i3,', ',i5,3(', ',i4),', ',i9
+     &       ,', ',i11,3(', ',i4))
 
 c     bug fix for IBM: flush the output stream so it actually writes
       flush(66)
@@ -20871,6 +20903,8 @@ subroutine find_maxmin (imax,jmax,dx,dy,cparm,fxy,maxmin,ist
         print *,' The immediately following lines for ilonfix, jlatfix,'
         print *,' ibeg, jbeg, iend and jend likely contain junk values'
         print *,' since we have not yet called get_ij_bounds....'
+        ilonfix = -9999
+        jlatfix = -9999
         print *,' ilonfix= ',ilonfix,' jlatfix= ',jlatfix
         print *,' ibeg= ',ibeg
         print *,' jbeg= ',jbeg
@@ -28977,7 +29011,7 @@ subroutine getgridinfo_grib (imax,jmax,ifh,dx,dy,lugb,lugi
             print *,'       GRID MIN & MAX LON '
             print *,'         (MODIFIED FOR GM WRAPPING):'
             print *,'         glonmin (same as original)= ',glonmin
-            print *,'         glonmax (modified)=         ',glonmax
+            print *,'         glonmax (modified)=         ',glonmax+360.
             print *,'       '
           endif
           glonmax = glonmax + 360.