c this file reads in the US STandard profile (model 6) and dumps it into
c a tabular text file

c compile with f77 -W -N114 -f read_glatm.f; /bin/mv a.out read_glatm.x
      IMPLICIT NONE
 
      INTEGER iModel,iGas

c      print *,'Enter model number (1 : 6) '
c      read *,iModel
c      print *,'Enter gas number (1 : 7) '
c      read *,iGas

      iGas = 2    !!!dump out stuff for gasID = xyz
      do iModel = 1,6
        CALL process(iModel,iGas)
        end do

      END

c ************************************************************************
c the main subroutine!!!
      SUBROUTINE process(iModel,iGas)

      IMPLICIT NONE

      INTEGER iModel,iGas

      INTEGER iIOUN,iErr,iNumLevs,iM
      CHARACTER*80 caS,caFin,caFout
      REAL rLat,raAlt(100),raP(100),raT(100),raD(100),raaG(7,100)
      CHARACTER*1 ca1

      caFin = 'glatm.dat'
      IF (iModel .EQ. 1) THEN
        caFout = 'trp'
      ELSEIF (iModel .EQ. 2) THEN
        caFout = 'mls'
      ELSEIF (iModel .EQ. 3) THEN
        caFout = 'mlw'
      ELSEIF (iModel .EQ. 4) THEN
        caFout = 'sas'
      ELSEIF (iModel .EQ. 5) THEN
        caFout = 'saw'
      ELSEIF (iModel .EQ. 6) THEN
        caFout = 'std'
      ELSE
        print *,'incorrect model, needs to be from 1 - 6 and not ',iModel
        stop
        END IF

      IF ((iGas .LT. 1) .OR. (iGas .GT. 7)) THEN
        print *,'incorrect gasID, needs to be from 1 - 7 and not ',iGas
        stop
        END IF
      write(ca1,999) iGas
      print *,iModel,iGas,' ---> ',ca1
      caFout(4:10) = '_gasID_'
      caFout(11:11) = ca1

      iIOUN = 10
      OPEN(UNIT=iIOUN,FILE=caFin,FORM='formatted',STATUS='OLD',IOSTAT=iErr)  
      IF (iErr .NE. 0) THEN  
        print *, 'error reading glatm profile ',iErr,caFin
        stop
        END IF  

      !read the header info until we get number of levels 
 10   CONTINUE
      read (iIOUN,100) caS
      IF (caS(1:1) .EQ. '!') THEN
        GOTO 10
      ELSE 
        read (caS,*) iNumLevs
        END IF

      iM = 0

 20   CONTINUE
      CALL ReadProfile(iIOUN,iNumLevs,rLat,raAlt,raP,raT,raD,raaG)
      iM = iM + 1
      IF (iM .LT. iModel) THEN
        GOTO 20
        END IF
      CLOSE(iIOUN)

      CALL PrintProfile(caFout,iNumLevs,iGas,rLat,raAlt,raP,raT,raD,raaG)

 100  FORMAT(A80)
 999  FORMAT(I1)
      RETURN
      END

c************************************************************************
c this reads in the profile info
      SUBROUTINE ReadProfile(iIOUN,iNumLevs,rLat,raAlt,raP,raT,raD,raaG)
     
      IMPLICIT NONE

c input
      INTEGER iIOUN,iNumLevs
c output
      REAL rLat,raAlt(100),raP(100),raT(100),raD(100),raaG(7,100)

c local
      INTEGER iI,iG
      CHARACTER*80 caS
      CHARACTER*20 ca20

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the model name
      ca20 = caS(1:20)
      write(*,20) ca20

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the latitude title
      read (iIOUN,*) rLat

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the altitude title
      read (iIOUN,*) (raAlt(iI),iI =1 ,iNumLevs)

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the pressure title
      read (iIOUN,*) (raP(iI),iI =1 ,iNumLevs)

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the temperture title
      read (iIOUN,*) (raT(iI),iI =1 ,iNumLevs)

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the density title
      read (iIOUN,*) (raD(iI),iI =1 ,iNumLevs)

      DO iG = 1,7
        read (iIOUN,100) caS                 ! read the bang
        read (iIOUN,100) caS                 ! read the gas title
        read (iIOUN,*) (raaG(iG,iI),iI =1 ,iNumLevs)
        END DO

      read (iIOUN,100) caS                 ! read the bang
      read (iIOUN,100) caS                 ! read the MODEND

 20   FORMAT(A20)
 100  FORMAT(A80)

      RETURN
      END

c************************************************************************
c this prints out the info
      SUBROUTINE PrintProfile(caFout,iNumLevs,iGas,rLat,raAlt,raP,raT,raD,raaG)

      IMPLICIT NONE

c input
      INTEGER iNumLevs,iGas
      REAL rLat,raAlt(100),raP(100),raT(100),raD(100),raaG(7,100)
      CHARACTER*80 caFout

c local
      INTEGER iI,iIOUN,iErr
      REAL raX(100),rX

      rX = 1.0
      IF (iGas .EQ. 2) THEN
        rX = 370.0/330.0
        END IF

      DO iI = 1,100
        raX(iI) = raaG(iGas,iI) * rX
        END DO

      iIOUN = 10
      OPEN(UNIT=iIOUN,FILE=caFout,FORM='formatted',STATUS='NEW',IOSTAT=iErr)  
      IF (iErr .NE. 0) THEN  
        print *, 'error writing model profile ',iErr,caFout
        stop
        END IF  

      DO iI = 1,iNumLevs
        write(iIOUN,100) iI,raAlt(iI),raP(iI),raT(iI),raX(iI)
        END DO
      CLOSE(iIOUN)

 100  FORMAT(I4,' ',F10.5,' ',E12.6,' ',F10.5,' ',E12.6,' ')

      RETURN
      END
c************************************************************************
