text:
c*************************************
        function afcor(iftype,t0,t,alpha)

c       computes filter responses for four types of filters used in
c       emslab long period mt experiment

cf      7.6.95  LMT MAGSON MAGNETOMETER low pass (10 sec) added

c       iftype  = 1 ==> no filter
c               = 2 ==> 1-pole high pass (uw mt)
c               = 3 ==> 2-pole high pass (epb mt)
c               = 4 ==> 2-pole low pass (uw,epb anti alias)
c               = 5 ==> 1-pole low pass (mag integrators)
c               = 6 ==> "box car" low pass filter - used by filloux
C-PDAS		=11 ==> PDAS 200 Hz low pass
C-PDAS	 	=12 ==> GMS05 coil system function
cf		=13 ==> LMT RAP Bessel low pass (10 sec)
cf		=14 ==> LMT MAGSON MAGNETOMETER low pass (5 sec)
cf		=15 ==> LMT RAP Bessel low pass (120 sec)
cf		=16 ==> LMT MAGSON MAGNETOMETER low pass (10 sec)

        complex afcor,temp
C-PDAS  LMT
	complex ce, p, pl
	real butter(3), butt2(4)
	real creal, cimag, acoef(10), bcoef(10), lmta(4), lmtb(5)
	real m1acoef(10),m1bcoef(10)
	real lmt120a(4), lmt120b(5)

	data lmta/0.9995,0.4884,-540.44,3314.08/
	data lmtb/0.0003,-30.2821,131.976,-645.841,56054.2/

	data butt2/1.,1.8019,1.2470,0.4450/
	data butter /1.9318,1.4141,0.5176/

cf......LMT RAP Bessel low pass (120 sec)
	data lmt120a/1.00938, -17.4907,-72672.1, 5.9892e06/
	data lmt120b/-0.0003034, -363.385, 19003.1, -1.115e06, 1.162e09/

cf......LMT MAGSON MAGNETOMETER low pass
C	*********************************
c	5sec:
c	*********************************

      data acoef/0.9999288296,0.0698487366,-36.54067611,
     $       -48.07610115,1362.242668,-5500.831271,10839.27048,
     $       -11784.68695,6791.730771,-1624.96809/
      data bcoef/-0.001502197016,5.873206596,46.9447023,
     $       -705.7354187,3305.132341,-8326.369934,12573.32541,
     $       -11432.56764,5792.333082,-1259.449763/

c	data acoef/5.1246, 0.86734, -522.35, 2967.31, -5167.64/
c	data bcoef/0.03539, -52.1911, 81.38222, 1594.21, -5209.82/

c	*********************************
c 	10sec:
c	*********************************
      data m1acoef/0.9997296956,0.6799243865,-194.6183338,
     $       1829.13399,-8241.197348,21653.75418,-34803.94742,
     $       33677.68098,-17990.74652,4066.264465/

      data m1bcoef/-0.02305288039,17.50142214,-141.2599948,
     $       268.8431802,1396.30022,-9193.972813,23246.24695,
     $       -31054.26697,21651.84395,-6217.244816/

c	data m1acoef/0.999608, 0.784654, -181.402, 1602.82,
c     &               -6747.79, 16490.1, -24583.9, 22046.0,
c     &               -10927.5 ,2299.88/
c	data m1bcoef/-0.0167768,15.7718,-112.219,148.612,1104.43,
c     &               -5478.73,11206.8,-12160.5,6864.87,-1589.04/

	ce = cmplx(1.,0.)

C-PDAS END
        go to(100,200,300,400,500,600,700,800,900,1000,1100,1200,
     &        1300,1400,1500,1600) iftype

C-PDAS
700	return
800	return
900	return
1000	return
C-PDAS END

100     continue
c       no filter
        afcor = (1.0,0.0)
        return

200     continue
c               uw-mt high pass
        gain = 1./sqrt(1.+(t/t0)*(t/t0))
        phase = atan(t/t0)
        temp = cmplx(0.,phase)
        afcor = gain*cexp(temp)
        return

300     continue

        r=t/t0
        t1 = r**4. + (alpha**2.-2.)*r**2. + 1.
        afcor = cmplx( (1.-r*r)/t1, alpha*r/t1 )
        return

400     continue

        r=t0/t
        t1 = r**4. + (alpha**2.-2.)*r**2. + 1.
        afcor = cmplx( (1.-r*r)/t1, (-1.)*alpha*r/t1 )
        return

500     continue
        r = t0/t
        gain = 1./sqrt(1.+(r*r))
        phase = atan(-r)
        temp = cmplx(0.,phase)
        afcor = gain*cexp(temp)
        return

600     continue
c    here t0 is width of box-car, alpha gives offset of boxcar center
c       from nominal sampling time
        if (t0.eq.0.) then
           afcor = 1.0
        else
           r = (t0/t)*3.14159
           afcor = sin(r)/r
        end if

        temp = cmplx(0.,6.28318*alpha/t)
        afcor = afcor * cexp(temp)
        return

C-PDAS	PDAS-Butterworth filter

1100	continue
        afcor = (1.0,0.0)
	r= 1./(t*200)
	do 1101 ibw = 1,3
 1101	afcor = afcor*(cmplx(1.-r*r,butter(ibw)*r))
	return

C-PDAS	GMS05 coil sys. function
1200	p = cmplx(0.,1./(t*4.))
	pl = cmplx (0.,1./(t*8192.))
	afcor = ((p/(ce+p))*(ce/(ce+pl)))
c       print*,t, 1./t, cabs(afcor), atan2(aimag(afcor),real(afcor))*180./3.1415
c	ce/
	return
C-PDAS END

C LMT

C	RA 7-pol Butterworth lowpass at 10 sec
C1300	r = 10./t
C	afcor = cmplx ( 1.  ,     butt2(1) *  r  )
C    &        * cmplx ( 1. - r*r, butt2(2) *  r  )
C     &        * cmplx ( 1. - r*r, butt2(3) *  r  )
C     &        * cmplx ( 1. - r*r, butt2(4) *  r  )
C	afcor = 1./afcor
c	print*,'T, abs, phi',t,(cabs(afcor)),(180./3.14159*
c     &  atan(aimag(afcor)/real(afcor)))

C	return

C       Fitting RA 7-Pol Bessel filter by a 4 and 3 pol polynom
1300    creal = 0.
	cimag = 0.
	do 1301 i = 1,4
	creal = creal + lmta(i)*(1./t)**(i-1)
1301	continue
	do 1302 i = 1,5
	cimag = cimag + lmtb(i)*(1./t)**(i-1)
1302	continue
        afcor =  (cmplx(creal,cimag))
c	print*,'T, abs, phi',t,(cabs(afcor)),(180./3.14159*
c     &  atan(aimag(afcor)/real(afcor)))

	return

C      MA  MAGSON magnetometer transfer function

1400	creal = 0.
	cimag = 0.
	do 1411 i = 1,10
	creal = creal + acoef(i)*(1./t)**(i-1)
	cimag = cimag + bcoef(i)*(1./t)**(i-1)
1411	continue
        afcor = (cmplx(-creal,cimag))/25.
c	print*,'T, abs, phi',t,(cabs(afcor)),(180./3.14159*
c     &  atan(aimag(afcor)/real(afcor)))

	return

C	R2 RAP 7 - Pol Bessel Low Pass at 120 s

1500    creal = 0.
	cimag = 0.
	do 1501 i = 1,4
	creal = creal + lmt120a(i)*(1./t)**(i-1)
1501	continue
	do 1502 i = 1,5
	cimag = cimag + lmt120b(i)*(1./t)**(i-1)
1502	continue
        afcor =  (cmplx(creal,cimag))
c	print*,'RA: T, abs, phi',t,(cabs(afcor)),(180./3.14159*
c     &  atan(aimag(afcor)/real(afcor)))

	return

C	M1 MAGSON magnetometer transfer function (10 sec low pass)

1600	creal = 0.
	cimag = 0.
	do 1601 i = 1,10
	creal = creal + m1acoef(i)*(1./t)**(i-1)
	cimag = cimag + m1bcoef(i)*(1./t)**(i-1)
1601	continue
        afcor = (cmplx(creal,cimag))
c	print*,'M1: T, abs, phi',t,(cabs(afcor)),(180./3.14159*
c    &  atan(aimag(afcor)/real(afcor)))

	return
	end
c
c----------------------------------------------------------------------
c
      subroutine resptbl(j,imode,igain,freq,resp,ijob)

      include 'iounits.inc'

CME	31/8/96
C	System response files for PAB (j=17) and MFS05 (j=18) included
C	Account for different headers of the calibration data files
C	and for inverse sequence of frequencies

cnew	added reading from generic table files. j =98 is a table of amplitudes
cnew	and phases, j=99 is one of real and imaginary part. Both modes asume
cnew	that any header information has non-numeric characters in
cnew	the first non-white-space position of a line.

      integer nfreq(3),j,imode,igain
      complex resp
      real tbl(3,9,0:150), temptbl(3)
      character*80 chead
      save tbl,nfreq

      if(ijob.eq.0) then
c        open the response table file
         open(unit=rsp_unit,file=cfrsp,status='old',iostat = ierr)
         if(ierr.ne.0) then
ccc         try changing from caps to large or vice-versa
           if(ichar(cfrsp(9:9)) .gt. 96) then
ccc           given name is lower case ... try caps
              cfrsp(9:9) = char(ichar(cfrsp(9:9))-32)
              cfrsp(10:10) = char(ichar(cfrsp(10:10))-32)
              cfrsp(18:18) = char(ichar(cfrsp(18:18))-32)
              cfrsp(19:19) = char(ichar(cfrsp(19:19))-32)
              cfrsp(20:20) = char(ichar(cfrsp(20:20))-32)
              if(cfrsp(9:9).eq.'E') then
                 cfrsp(16:16) = char(ichar(cfrsp(16:16))-32)
              endif

              print*,'cfrsp',cfrsp
              open(unit=rsp_unit,file=cfrsp,status='old',err=220)
           else
ccc           given name is caps ... try lower case
              cfrsp(9:9) = char(ichar(cfrsp(9:9))+32)
              cfrsp(10:10) = char(ichar(cfrsp(10:10))+32)
              cfrsp(18:18) = char(ichar(cfrsp(18:18))+32)
              cfrsp(19:19) = char(ichar(cfrsp(19:19))+32)
              cfrsp(20:20) = char(ichar(cfrsp(20:20))+32)
              if(cfrsp(9:9).eq.'e') then
                 cfrsp(16:16) = char(ichar(cfrsp(16:16))+32)
              endif
              print*,'cfrsp',cfrsp
              open(unit=rsp_unit,file=cfrsp,status='old',err=220)
            endif
         endif
         goto 221
c        Still can't fine response file ... ask user to enter a new name
 220     print*,' Couldn''t open RSP file:', cfrsp
         print*,' Enter a new RSP file name or RETURN to stop.'
         read (5,*) cfrsp
         if (cfrsp(1:1).eq.' ') then
            stop
         else
            open(unit=rsp_unit,file=cfrsp,status='old',err = 222)
         endif
 221     continue
         if (j.eq.7 .or. j.eq.8) then
c     read in table of system reponses
c     emi mt-1 response tables
            read(rsp_unit,'(a80)')
            read(rsp_unit,'(a80)')
            read(rsp_unit,'(a80)')
            read(rsp_unit,'(a80)')
            read(rsp_unit,'(a80)')
            if(j.eq.7) then
               do 20 k = 1,3
                  read(rsp_unit,*) nfreq(k)
                  do l = 1,nfreq(k)
                     read(rsp_unit,'(9g6.0)') (tbl(k,i,l),i=1,9)
                  enddo
                  tbl(k,1,0) = 0.
                  do i = 2,9
                     tbl(k,i,0) = tbl(k,i,1)
                  enddo
 20            continue
            else		! j = 8
               read(rsp_unit,*) nfreq(1)
               do k = 1,nfreq(1)
                  read(rsp_unit,'(3g6.0)') (tbl(1,i,k),i=1,3)
               enddo
               tbl(1,1,0) = 0.
               do i = 2,3
                  tbl(1,i,0) = tbl(1,i,1)
               enddo
               imode = 1
               igain = 1
            end if

C	this is PDAS/SPAM format of table files
         else if (j.ge.17 .and. j.lt.98) then
            chead = ' '
            do while (chead(1:5).ne.'-----')
               read(rsp_unit,'(a80)') chead
            end do
            read(rsp_unit,'(a80)') chead
            do k=1,150
               read (rsp_unit,*,end=500,err=500) (tbl(1,i,k),i=1,3)
            end do
 500        nfreq(1) = k-1
            nnfreq = nfreq(1)/2 + mod(nfreq(1),2)
C-PDAS invert sequence of frequencies
            do k=1,nnfreq
               do i = 1,3
                  temptbl(i) = tbl(1,i,k)
                  tbl(1,i,k) = tbl(1,i,nfreq(1)+1-k)
                  tbl(1,i,nfreq(1)+1-k) = temptbl(i)
               end do
            end do
            tbl(1,1,0) = 0.
            do i = 2,3
               tbl(1,i,0) = tbl(1,i,1)
            end do
            imode = 1
            igain = 1
c     end of pdas/mms05 table reading

cnew	this is the generic amplitude/phase or real/imaginary table
         elseif (j.eq.98 .or. j.eq.99) then
            read (rsp_unit,'(a80)') chead
cnew	skip all lines whic have non-numeric characters as first
cnew	non-white-space character (icfirst is integer function in inpu_bin.f)
            do while (
     &           ichar(chead(icfirst(chead,80):icfirst(chead,80)+1))
     &           .lt.48 .or.
     &           ichar(chead(icfirst(chead,80):icfirst(chead,80)+1))
     &           .gt.57 )
               read (rsp_unit,'(a80)') chead
            enddo
            backspace(rsp_unit)
            do k=1,150
               read (rsp_unit,*,end=501,err=501) (tbl(1,i,k),i=1,3)
            end do
 501        nfreq(1) = k-1
cnew 	check if frequencies increase, if not invert
            if (tbl(1,1,1) .gt. tbl(1,1,nfreq(1))) then
               nnfreq = nfreq(1)/2 + mod(nfreq(1),2)
               do k=1,nnfreq
                  do i = 1,3
                     temptbl(i) = tbl(1,i,k)
                     tbl(1,i,k) = tbl(1,i,nfreq(1)+1-k)
                     tbl(1,i,nfreq(1)+1-k) = temptbl(i)
                  end do
               end do
               tbl(1,1,0) = 0.
               do i = 2,3
                  tbl(1,i,0) = tbl(1,i,1)
               end do
            endif
            imode = 1
            igain = 1
         end if

         close (rsp_unit)
         return

      else		!  (ijob .eq. 1)

c      interpolate frequency
         ip = 2*igain+1
         ig = ip-1
         do 40 i=0,nfreq(imode)-1
            if((tbl(imode,1,i).lt.freq).and.
     &           (freq.le.tbl(imode,1,i+1)))then
               w=(tbl(imode,1,i+1)-freq)/(tbl(imode,1,i+1)-
     &              tbl(imode,1,i))
               g = tbl(imode,ig,i)*w+tbl(imode,ig,i+1)*(1.-w)
               p = tbl(imode,ip,i)*w+tbl(imode,ip,i+1)*(1.-w)
cnew	if j = 99 the table is alredy in real/imaginary style
               if (j.eq.99) then
                  resp = cmplx(g,p)
               else
                  resp = cmplx(0.,3.14159*p/180.)
                  resp = g*cexp(resp)
               endif
               return
            end if
 40      continue
         print*,'resptbl failed'
         stop
      end if
 222  print*,' ERROR OPENING RSP-FILE ! looked up in SENSORS'
      end
c
c----------------------------------------------------------------------
c
      subroutine pz_rsp(nzeros,npoles,a0,zeros,poles,freq,rsp)

ccc   compute response rsp at frequncy freq, in cycles/sec
ccc   TF is given in terms of poles and zeros (specified in radians/sec)
ccc   normalization factor is a0

      real*4 freq,a0,pi
      parameter (pi=3.1415926536)
      integer*4 nzeros,npoles,kz,kp
      complex*8 zeros(100),poles(100),w,rsp

      rsp = a0
      w = cmplx(0,freq*2*pi)
      do kz=1,nzeros
         rsp = rsp*(w-zeros(kz))
      enddo
      do kp=1,npoles
         rsp = rsp/(w-poles(kp))
      enddo
      return
      end

max_stars_repo_name: simpeg-research/iris-mt-scratch

max_issues_repo_name: simpeg-research/iris-mt-scratch

max_forks_repo_name: simpeg-research/iris-mt-scratch


text:
C++--------------------------------------------------------------------
C Program to smooth images with possibility of unsharp masking.
C JLP
C Version of 12-11-91
C--------------------------------------------------------------------
	PROGRAM SMOOTH1
        INTEGER GSIZE
        PARAMETER(GSIZE=31)
	REAL*4 GRID(GSIZE,GSIZE)
	INTEGER*4 PNTR_IN,PNTR_OUT,ISIZE
	INTEGER*4 MADRID(1)
	CHARACTER NAME*40,NAME_OUT*40,COMMENTS*80
        CHARACTER NSMOOTH*30,ANS*1,BUFFER*40
	LOGICAL UNSHARP
	COMMON /VMR/MADRID

10	FORMAT(A)
	PRINT 5
5	FORMAT(' Program smooth1 to smooth 2-D images'
     1	,/,' Possibility of unsharp masking',/,' Version 12-11-91')

        CALL JLP_BEGIN
C Inquires about the format of the files :
	CALL JLP_INQUIFMT

C Read the input image :
        WRITE(6,*) 'Input file: '
        READ(5,10) NAME
	CALL JLP_VM_READIMAG(PNTR_IN,NX,NY,NAME,COMMENTS)

	PRINT 70
70	FORMAT(' MENU : ',/,
     1	' 1. INPUT OF THE VALUES FOR THE GRID',
     1	' AND STORAGE IN A FILE',/,
     1	' 2. GAUSSIAN GRID',/,
     1	' 3. "TOP HAT" ',/,
     1	' 4. GRID FROM A FILE ',/,
     1	' ENTER THE OPTION : ',$)
	READ(5,*) IOPT

	PRINT *,' SIZE OF SMOOTHING GRID (ODD INTEGER IN RANGE 1-',GSIZE,') '
	READ(5,*) NSM

C-------------------------------------------------------------
C IOPT=1 Input of the values and storage in a file :
	IF(IOPT.EQ.1)THEN
        WRITE(BUFFER,11) NSM
11      FORMAT(' Width of spec. grid:',I4)
	IOP=4
	SUM=0.
	DO J=1,NSM
	 PRINT 101,J
101	 FORMAT(' LINE :',I3)
	   DO I=1,NSM
	    PRINT 102,I
102	    FORMAT('  ',I3,' := ',$)
	    READ(5,*) GRID(I,J)
	    SUM=SUM+GRID(I,J)
	   END DO
	END DO

	IF(SUM.NE.1.)THEN
	PRINT 106
106	FORMAT(' WARNING : THE GRID IS NOT NORMALIZED',/,
     1	' DO YOU WANT ME TO NORMALIZE IT ? (Y)')
	READ(5,10) ANS
	  IF(ANS.NE.'N'.AND.ANS.NE.'n')THEN
	   DO I=1,NSM
	    DO J=1,NSM
	     GRID(I,J)=GRID(I,J)/SUM
	    END DO
	   END DO
	   PRINT *,' GRID NORMALIZED'
	  ENDIF
	ENDIF

105	PRINT *,' NAME OF THE OUTPUT FILE (GRID) ?'
	READ(5,10) NSMOOTH
	OPEN(1,FILE=NSMOOTH,STATUS='NEW',ERR=105)
	WRITE(1,*) ((GRID(I,J),I=1,NSM),J=1,NSM)
	CLOSE(1)
	ENDIF

C-------------------------------------------------------------
C IOPT=2  Gaussian grid:
	IF(IOPT.EQ.2)THEN
        WRITE(BUFFER,12) NSM
12      FORMAT(' Width of Gauss grid:',I4)
	  IOP=2
	  PRINT 203
203	  FORMAT(' SIGMA (IN PIXELS) : ',$)
	  READ(5,*) SIGMA
	ENDIF

C-------------------------------------------------------------
C IOPT=3  "Top Hat" :
	IF(IOPT.EQ.3)THEN
          IOP=3
          WRITE(BUFFER,13) NSM
13        FORMAT(' Width of Top Hat grid:',I4)
        ENDIF

C-------------------------------------------------------------
C IOPT=4 Input of a file :
	IF(IOPT.EQ.4)THEN
	  IOP=4
          WRITE(BUFFER,14) NSM
14        FORMAT(' Width of file grid:',I4)
405	  PRINT *,' Name of precalculated smoothing grid'
	  READ(5,10) NSMOOTH

	  OPEN(1,FILE=NSMOOTH,STATUS='OLD',ERR=405)
	  READ(1,*) ((GRID(I,J),I=1,NSM),J=1,NSM)
	  CLOSE(1)

	ENDIF

C--------------------------------------------------------------
C Prints the grid if IOP=4
	IF(IOP.EQ.4)THEN
	  PRINT 801
801	  FORMAT(' SMOOTHING GRID :')
	  DO J=1,NSM
	    DO I=1,NSM
	     PRINT *,I,J,GRID(I,J)
	    END DO
	  END DO
	ENDIF
C-------------------------------------------------------------
C Unsharp masking :
	PRINT *,' DO YOU WANT UNSHARP MASKING ? (N)'
	READ(5,10) ANS
	UNSHARP=(ANS.EQ.'Y'.OR.ANS.EQ.'y')
	 IF(UNSHARP)THEN
	  PRINT *,' FRACTION OF THE SMOOTHED IMAGE YOU WANT TO REMOVE ?'
	  READ(5,*) FRACT
	 ENDIF

C Output file:
	PRINT *,' OUTPUT FILE:'
	READ(5,10) NAME_OUT
	ISIZE=NX*NY*4
	CALL JLP_GETVM(PNTR_OUT,ISIZE)

C Calls SMOOTH2 :
C   IOP=2 Gauss
C   IOP=3 Top hat
C   IOP=4 Input grid

	CALL SMOOTH2(MADRID(PNTR_IN),MADRID(PNTR_OUT),
     1	NX,NY,NX,IOP,GRID,NSM,SIGMA,UNSHARP,FRACT)

C Output :
	IN=INDEX(NAME,' ')
	  IF(UNSHARP)THEN
	   WRITE(COMMENTS,902)NAME(1:IN),BUFFER(1:30)
902	   FORMAT(' Unsharp mask from :',A,A)
	  ELSE
	   WRITE(COMMENTS,903)NAME(1:IN),BUFFER(1:30)
903	   FORMAT('Smoothed image of:',A,A)
	  ENDIF
	CALL JLP_WRITEIMAG(MADRID(PNTR_OUT),NX,NY,NX,
     1	NAME_OUT,COMMENTS)

	CALL JLP_END
	STOP
	END
C------------------------------------------------------------------------
	include 'jlpsub:smooth2.for'

ext: for


text:
program t
! test for i, f, t, tl, tr, and l in format-item-list
  integer::a=1234
  real::b=3.141592654
  logical::c=.true.
9876 format(T17,I5,I2.1,tl14,F6.3,tr25,L4)
  write (*,9876) a,a,b,c
endprogram t

max_stars_repo_name: maddenp/ppp

max_issues_repo_name: maddenp/ppp

max_forks_repo_name: maddenp/ppp


text:
Describe Users/niumaiaravulo here.
lives in sacramento, california

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
character(:), allocatable :: array(:,:)
array = reshape(['foo','bar'],shape=[2,1])
call sub (array)
contains
  subroutine sub (array)
    class(*), intent(in) :: array(:,:)
    class(*), allocatable :: copy(:,:)
    select type (array)
    type is (character(*))
      print '(a,3i2,1x,2a)', 'orig=', len(array), shape(array), array
    end select
    allocate(copy, source=array)
    select type (copy)
    type is (character(*))
      print '(a,3i2,1x,2a)', 'copy=', len(copy), shape(copy), copy
    end select
  end
end

max_stars_repo_name: dhnza/fortran-compiler-tests

max_issues_repo_name: dhnza/fortran-compiler-tests

max_forks_repo_name: dhnza/fortran-compiler-tests


text:
c     Subroutine to find maximum distance
c     AJ_Kettle, 28Jun2019
c     16Mar2020: used for uSAF update

      SUBROUTINE find_max_distance_span(l_rgh_datalines,
     +  i_triplediff_cnt,f_triplediff_lat,f_triplediff_lon,
     +  f_max_distance_span_km)

      IMPLICIT NONE
c************************************************************************
c     Variables from outside subroutine
      INTEGER             :: l_rgh_datalines
      INTEGER             :: i_triplediff_cnt
      REAL                :: f_triplediff_lat(l_rgh_datalines)
      REAL                :: f_triplediff_lon(l_rgh_datalines)
      REAL                :: f_max_distance_span_km
c*****
c     Variables used within subroutine

      INTEGER             :: i,j,k,ii,jj,kk
      REAL                :: f_pi

      REAL                :: f_lat_max
      REAL                :: f_lat_min
      REAL                :: f_lon_max
      REAL                :: f_lon_min
c************************************************************************
c      print*,'just inside find_max_distance_span'

c      print*,'i_triplediff_cnt=',i_triplediff_cnt
c      print*,'l_rgh_datalines=',l_rgh_datalines
c      print*,'f_triplediff_lat=',
c     +  (f_triplediff_lat(i),i=1,i_triplediff_cnt)
c      print*,'f_triplediff_lon=',
c     +  (f_triplediff_lon(i),i=1,i_triplediff_cnt)

      f_pi=3.14159

      f_lat_max=-1000.0
      f_lat_min=+1000.0
      f_lon_max=-1000.0
      f_lon_min=+1000.0

      DO i=1,i_triplediff_cnt
       f_lat_max=MAX(f_lat_max,f_triplediff_lat(i))
       f_lat_min=MIN(f_lat_min,f_triplediff_lat(i))

       f_lon_max=MAX(f_lon_max,f_triplediff_lon(i))
       f_lon_min=MIN(f_lon_min,f_triplediff_lon(i))
      ENDDO

      f_max_distance_span_km=SQRT(
     + ((f_lat_max-f_lat_min)*110.0)**2.0+
     + ((f_lon_max-f_lon_min)*110.0*COS(f_lat_min*f_pi/180.0))**2.0)

c      print*,'f_triplediff_lat=',
c     +  (f_triplediff_lat(i),i=1,i_triplediff_cnt)
c      print*,'f_triplediff_lon=',
c     +  (f_triplediff_lon(i),i=1,i_triplediff_cnt)

c      print*,'f_lat_max=',f_lat_max
c      print*,'f_lat_min=',f_lat_min
c      print*,'f_lon_max=',f_lon_max
c      print*,'f_lon_min=',f_lon_min

c      print*,'f_max_distance_span_km=',f_max_distance_span_km

c      print*,'just leaving find_max_distance_span'

c      STOP 'find_max_distance_span'

      RETURN
      END

max_stars_repo_name: glamod/glamod-nuim

max_issues_repo_name: glamod/glamod-nuim

max_forks_repo_name: glamod/glamod-nuim


!----------------------------------------------------------------------------------
!:sdoc+:
!
!
! CRTM_FASTEM_MODULE
!
! This module is provided to "wrap" all the existing CRTM FASTEM
! versions and provide a general interface to simplify integration into
! the main CRTM_SfcOptics module.
!
!
! CREATION HISTORY:
!      Written by:      Paul van Delst, 25-Jun-2005
!                       paul.vandelst@noaa.gov
!      Modified by:     Ming Chen, 08-Feb-2015
!                       ming.chen@noaa.gov
!:sdoc-:
!-----------------------------------------------------------------------------------------------
!
!

MODULE CRTM_FASTEM_MODULE

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE CSEM_Type_Kinds,          ONLY: fp => CSEM_fp
  USE CSEM_Exception_Handler,   ONLY: SUCCESS
  USE CRTM_FASTEM_Parameters,         ONLY: SET, NOT_SET, &
                                      ZERO, ONE, &
                                      MAX_N_ANGLES, &
                                      N_STOKES => MAX_N_STOKES
  USE CRTM_LowFrequency_MWSSEM, ONLY: LF_MWSSEM_type => iVar_type, &
                                      LowFrequency_MWSSEM, &
                                      LowFrequency_MWSSEM_TL, &
                                      LowFrequency_MWSSEM_AD
  USE CRTM_Fastem1,             ONLY: Fastem1
  USE CRTM_FastemXX,            ONLY: FastemX_type => iVar_type, &
                                     Compute_FastemX    => Compute_FastemXX,   &
                                     Compute_FastemX_TL => Compute_FastemXX_TL,&
                                     Compute_FastemX_AD => Compute_FastemXX_AD
  USE FASTEM_Coeff_Reader,   MWwaterC => CSEM_MWwaterC

  ! Disable implicit typing
  IMPLICIT NONE

  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Data types
  PUBLIC :: iVar_type
  ! Science routines
  PUBLIC :: CRTM_FASTEM_Emiss
  PUBLIC :: Compute_FASTEM_SfcOptics
  PUBLIC :: Compute_FASTEM_SfcOptics_TL
  PUBLIC :: Compute_FASTEM_SfcOptics_AD
  PUBLIC :: CRTM_FASTEM_Init
  PUBLIC :: CRTM_FASTEM_Destroy
  PUBLIC :: CSEM_MWwaterCoeff_INIT

  ! -----------------
  ! Module parameters
  ! -----------------
  ! RCS Id for the module
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  '$Id: CRTM_MW_Water_SfcOptics.f90 21141 2012-09-14 17:40:43Z paul.vandelst@noaa.gov $'
  ! Low frequency model threshold
  REAL(fp), PARAMETER :: LOW_F_THRESHOLD = 20.0_fp ! GHz

  LOGICAL,SAVE :: CSEM_MWwaterCoeff_INIT = .FALSE.

  ! --------------------------------------
  ! Structure definition to hold forward
  ! variables across FWD, TL, and AD calls
  ! --------------------------------------
  TYPE :: iVar_type
    PRIVATE
    ! FastemX model internal variable structure
    TYPE(FastemX_type), DIMENSION(MAX_N_ANGLES) :: FastemX_Var
    ! Low frequency model internal variable structure
    TYPE(LF_MWSSEM_type), DIMENSION(MAX_N_ANGLES) :: LF_MWSSEM_Var
    LOGICAL :: Is_LOW_Freq = .FALSE.
    ! Fastem outputs
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: dEH_dTs        = ZERO
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: dEH_dWindSpeed = ZERO
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: dEV_dTs        = ZERO
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: dEV_dWindSpeed = ZERO
  END TYPE iVar_type

CONTAINS
!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_FASTEM_Emiss
!
! PURPOSE:
!       Function to compute the surface emissivity and reflectivity at microwave
!       frequencies over a water surface and at SINGLE frequency channel and SINGLE
!       receiving angle
!
!       This function is a wrapper of different FASTEM versions
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_FASTEM_Emiss(
!                              Frequency                              , &  ! Input
!                              Angle                                  , &  ! Input
!                              Water_Temperature                      , &  ! Input
!                              Salinity                               , &  ! Input
!                              Wind_Speed                             , &  ! Input
!                              Wind_Direction                         , &  ! Input
!                              Emissivity                             , &  ! Output
!                              Reflectivity                           , &  ! Output
!                              FASTEM_Version                         , &  ! Input
!                              Sensor_Azimuth_Angle                   , &  ! Input
!                              Transmittance)                           &  ! Input
! INPUTS:
!      Frequency:        Frequency
!                        UNITS:      GHz
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Angle:            Receiving Angle
!                        UNITS:      Degree
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Water_Temperature:Water surface temperature
!                        UNITS:      K
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Salinity:         Water salinity
!                        UNITS:      Per thousand
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Wind_Speed:       Ocean surface wind speed
!                        UNITS:      m/s
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Wind_Direction:   Wind direction
!                        UNITS:      Degree
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      FASTEM_Version:   FASTEM version index
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Sensor_Azimuth_Angle: Sensor azimuth angle
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: OPTIONAL INTENT(IN)
!
!      Transmittance :   Atmospheric transmittance
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: OPTIONAL INTENT(IN)

! OUTPUTS:
!      Emissivity:       Full Stokes surface emissivity
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Array(4)
!                        ATTRIBUTES: INTENT(OUT)
!
!      Reflectivity:     Full Stokes surface reflectivity
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  ARRAY(4)
!                        ATTRIBUTES: INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the Message_Handler module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION CRTM_FASTEM_Emiss( &
           Frequency                              , &  ! Input
           Angle                                  , &  ! Input
           Water_Temperature                      , &  ! Input
           Salinity                               , &  ! Input
           Wind_Speed                             , &  ! Input
           Wind_Direction                         , &  ! Input
           Emissivity                             , &  ! Output
           Reflectivity                           , &  ! Output
           FASTEM_Version                         , &  ! Input
           Sensor_Azimuth_Angle                   , &  ! Input
           Transmittance)                           &  ! Input
  RESULT( err_stat )

    ! Arguments
    REAL(fp), INTENT(IN)   :: Frequency
    REAL(fp), INTENT(IN)   :: Angle
    REAL(fp), INTENT(IN)   :: Water_Temperature
    REAL(fp), INTENT(IN)   :: Salinity
    REAL(fp), INTENT(IN)   :: Wind_Speed
    REAL(fp), INTENT(IN)   :: Wind_Direction
    REAL(fp), INTENT(OUT)  :: Reflectivity(N_STOKES)
    REAL(fp), INTENT(OUT)  :: Emissivity(N_STOKES)
    INTEGER,  INTENT(IN)   :: FASTEM_Version
    REAL(fp), INTENT(IN)   :: Sensor_Azimuth_Angle
    REAL(fp), INTENT(IN)   :: Transmittance

    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_MW_Water_SfcOptics'
    ! Local variables
    REAL(fp) :: Azimuth_Angle
    TYPE(FastemX_type )  :: iVar_FastemX
    TYPE(LF_MWSSEM_type) :: iVar_LF_MWSSEM
    REAL(fp) :: dEH_dWindSpeed , dEV_dWindSpeed
    INTEGER :: nZ = 2

    ! Set up
    err_stat = SUCCESS
    Reflectivity = ZERO

    ! Compute the surface optical parameters
    IF( FASTEM_Version == 6   .OR. FASTEM_Version == 5 ) THEN
       ! FastemX model
       Azimuth_Angle = Wind_Direction - Sensor_Azimuth_Angle

       CALL Compute_FastemX(                   &
               MWwaterC                       , & ! Input model coefficients
               Frequency                      , & ! Input
               nZ                             , &  ! Input
               Angle                          , & ! Input
               Water_Temperature              , & ! Input
               Salinity                       , & ! Input
               Wind_Speed                     , & ! Input
               iVar_FastemX                   , & ! Internal variable output
               Emissivity(:)                  , & ! Output
               Reflectivity(:)                , & ! Output
               Azimuth_Angle                  , & ! Optional input
               Transmittance                    )  ! Optional input
      ELSE
        ! Low frequency model coupled with Fastem1
        IF( Frequency < LOW_F_THRESHOLD ) THEN
           ! Call the low frequency model
           CALL LowFrequency_MWSSEM( &
                 Frequency                    , & ! Input
                 Angle                        , & ! Input
                 Water_Temperature            , & ! Input
                 Salinity                     , & ! Input
                 Wind_Speed                   , & ! Input
                 Emissivity                   , & ! Output
                 iVar_LF_MWSSEM                 ) ! Internal variable output
            Reflectivity = ONE-Emissivity
        ELSE
          ! Call Fastem1
           CALL Fastem1( Frequency            , & ! Input
                  Angle                       , & ! Input
                  Water_Temperature           , & ! Input
                  Wind_Speed                  , & ! Input
                  Emissivity                  , & ! Output
                  dEH_dWindSpeed              , & ! Output
                  dEV_dWindSpeed                ) ! Output
            Reflectivity = ONE-Emissivity

        END IF

    END IF

  END FUNCTION CRTM_FASTEM_Emiss

!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!      Compute_FASTEM_SfcOptics
!
! PURPOSE:
!       Function to compute the surface emissivity and reflectivity at microwave
!       frequencies over a water surface and at SINGLE frequency channel and MULTIPLE
!       receiving angle
!
!       This function is a wrapper of different FASTEM versions
!
! CALLING SEQUENCE:
!       Error_Status = Compute_FASTEM_SfcOptics(
!                                 Frequency                              , &  ! Input
!                                 Angle                                  , &  ! Input
!                                 Water_Temperature                      , &  ! Input
!                                 Salinity                               , &  ! Input
!                                 Wind_Speed                             , &  ! Input
!                                 Wind_Direction                         , &  ! Input
!                                 iVar                                   , &  ! Input
!                                 Emissivity                             , &  ! Output
!                                 Reflectivity                           , &  ! Output
!                                 FASTEM_Version                         , &  ! Input
!                                 Sensor_Azimuth_Angle                   , &  ! Input
!                                 Transmittance)                           &  ! Input
! INPUTS:
!      Frequency:        Frequency
!                        UNITS:      GHz
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Angle:            Receiving Angle
!                        UNITS:      Degree
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(IN)
!
!      Water_Temperature:Water surface temperature
!                        UNITS:      K
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Salinity:         Water salinity
!                        UNITS:      Per thousand
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Wind_Speed:       Ocean surface wind speed
!                        UNITS:      m/s
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Wind_Direction:   Wind direction
!                        UNITS:      Degree
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      FASTEM_Version:   FASTEM version index
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Sensor_Azimuth_Angle: Sensor azimuth angle
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: OPTIONAL INTENT(IN)
!
!      Transmittance :   Atmospheric transmittance
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: OPTIONAL INTENT(IN)
!
!
! OUTPUTS:
!      Emissivity:       Full Stokes surface emissivity
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(OUT)
!
!      Reflectivity:     Full Stokes surface reflectivity
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(OUT)
!
!      iVar:             Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(OUT)
!
!      iVar:             Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the Message_Handler module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION Compute_FASTEM_SfcOptics(  &
           Frequency                              , &  ! Input
           Angles                                 , &  ! Input
           Water_Temperature                      , &  ! Input
           Salinity                               , &  ! Input
           Wind_Speed                             , &  ! Input
           Wind_Direction                         , &  ! Input
           iVar                                   , &  ! InOUT
           Emissivity                             , &  ! Output
           Reflectivity                           , &  ! Output
           FASTEM_Version                         , &  ! Input
           Sensor_Azimuth_Angle                   , &  ! Input
           Transmittance)                           &  ! Input
  RESULT( err_stat )

    ! Arguments
    REAL(fp), INTENT(IN)   :: Frequency
    REAL(fp), INTENT(IN)   :: Angles(:)
    REAL(fp), INTENT(IN)   :: Water_Temperature
    REAL(fp), INTENT(IN)   :: Salinity
    REAL(fp), INTENT(IN)   :: Wind_Speed
    REAL(fp), INTENT(IN)   :: Wind_Direction
    REAL(fp), INTENT(OUT)  :: Reflectivity(:,:)
    REAL(fp), INTENT(OUT)  :: Emissivity(:,:)
    INTEGER,  INTENT(IN)   :: FASTEM_Version
    REAL(fp), INTENT(IN)   :: Sensor_Azimuth_Angle
    REAL(fp), INTENT(IN)   :: Transmittance
    TYPE(iVar_type),  INTENT(OUT) :: iVar

    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_MW_Water_SfcOptics'
    ! Local variables
    INTEGER  :: i, nZ
    REAL(fp) :: Azimuth_Angle

    ! Set up
    err_stat = SUCCESS
    Reflectivity = ZERO
    nZ = size(Angles)

    ! Compute the surface optical parameters
    IF( FASTEM_Version == 6 .OR. FASTEM_Version == 5) THEN
      ! FastemX model
      Azimuth_Angle = Wind_Direction - Sensor_Azimuth_Angle

      DO i = 1, nZ
        CALL Compute_FastemX( &
               MWwaterC                               , &  ! Input model coefficients
               Frequency                              , &  ! Input
               nZ                                     , &  ! Input
               Angles(i)                              , &  ! Input
               Water_Temperature                      , &  ! Input
               Salinity                               , &  ! Input
               Wind_Speed                             , &  ! Input
               iVar%FastemX_Var(i)                    , &  ! Internal variable output
               Emissivity(i,:)                        , &  ! Output
               Reflectivity(i,:)                      , &  ! Output
               Azimuth_Angle                          , &  ! Optional input
               Transmittance                            )  ! Optional input
      END DO

    ELSE

      ! Low frequency model coupled with Fastem1
      IF( Frequency < LOW_F_THRESHOLD ) THEN
        iVar%Is_LOW_Freq = .TRUE.
        ! Call the low frequency model
        DO i = 1, nZ
          CALL LowFrequency_MWSSEM( &
                 Frequency                            , &  ! Input
                 Angles(i)                            , &  ! Input
                 Water_Temperature                    , &  ! Input
                 Salinity                             , &  ! Input
                 Wind_Speed                           , &  ! Input
                 Emissivity(i,:)                      , &  ! Output
                 iVar%LF_MWSSEM_Var(i)                  )  ! Internal variable output
          Reflectivity(i,1:2) = ONE - Emissivity(i,1:2)
        END DO
      ELSE
        ! Call Fastem1
        DO i = 1, nZ
          CALL Fastem1( Frequency                     , &  ! Input
                        Angles(i)                     , &  ! Input
                        Water_Temperature             , &  ! Input
                        Wind_Speed                    , &  ! Input
                        Emissivity(i,:)               , &  ! Output
                        iVar%dEH_dWindSpeed(i)        , &  ! Output
                        iVar%dEV_dWindSpeed(i)          )  ! Output
          Reflectivity(i,1:2) = ONE- Emissivity(i,1:2)
        END DO
      END IF

    END IF

  END FUNCTION Compute_FASTEM_SfcOptics

!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!      Compute_FASTEM_SfcOptics_TL
!
! PURPOSE:
!       Function to compute the tangent-linear surface emissivity and
!       reflectivity at microwave frequencies over a water surface.
!
!       This function is a wrapper of different FASTEM versions
!
! CALLING SEQUENCE:
!       Error_Status = Compute_FASTEM_SfcOptics_TL(
!                            Water_Temperature_TL                   , &  ! Input
!                            Salinity_TL                            , &  ! Input
!                            Wind_Speed_TL                          , &  ! Input
!                            Wind_Direction_TL                      , &  ! Input
!                            iVar                                   , &  ! Input
!                            EmissivityTL                           , &  ! Output
!                            Reflectivity_TL                        , &  ! Output
!                            FASTEM_Version)                          &  ! Input
! INPUTS:
!
!      Water_Temperature_TL:Water surface temperature tangent-linear
!                        UNITS:      K
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Salinity_TL:      Water salinity tangent-linear
!                        UNITS:      Per thousand
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Wind_Speed_TL:    Ocean surface wind speed tangent-linear
!                        UNITS:      m/s
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      Wind_Direction_TL:Wind direction tangent-linear
!                        UNITS:      Degree
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      FASTEM_Version:   FASTEM version index
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      iVar:             Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)

! OUTPUTS:
!      Emissivity_TL:    Full Stokes surface emissivity tangent-linear
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(OUT)
!
!      Reflectivity_TL:  Full Stokes surface reflectivity tangent-linear
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the Message_Handler module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION Compute_FASTEM_SfcOptics_TL(   &
           Water_Temperature_TL                 , &  ! Input
           Salinity_TL                          , &  ! Input
           Wind_Speed_TL                        , &  ! Input
           Wind_Direction_TL                    , &  ! Input
           Transmittance_TL                     , &  ! Input
           iVar                                 , &  ! InOUT
           Emissivity_TL                        , &  ! Output
           Reflectivity_TL                      , &  ! Output
           FASTEM_Version )                       &  ! Input
  RESULT( err_stat )
    ! Arguments
    REAL(fp), INTENT(IN)   :: Water_Temperature_TL
    REAL(fp), INTENT(IN)   :: Salinity_TL
    REAL(fp), INTENT(IN)   :: Wind_Speed_TL
    REAL(fp), INTENT(IN)   :: Wind_Direction_TL
    REAL(fp), INTENT(IN)   :: Transmittance_TL
    REAL(fp), INTENT(OUT)  :: Reflectivity_TL(:,:)
    REAL(fp), INTENT(OUT)  :: Emissivity_TL(:,:)
    INTEGER,  INTENT(IN)   :: FASTEM_Version

    TYPE(iVar_type),              INTENT(IN)     :: iVar
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_MW_Water_SfcOptics_TL'
    ! Local variables
    INTEGER :: i, nZ

    ! Set up
    err_stat = SUCCESS
    nZ = size(Emissivity_TL,1)
    Reflectivity_TL = ZERO
    ! ...Retrieve data from structures

    ! Compute the tangent-linear surface optical parameters
    IF( FASTEM_Version == 6 .OR. FASTEM_Version == 5) THEN

      ! FastemX model
      DO i = 1, nZ
         CALL Compute_FastemX_TL( &
               MWwaterC                            , &  ! Input model coefficients
               Water_Temperature_TL                , &  ! TL Input
               Salinity_TL                         , &  ! TL Input
               Wind_Speed_TL                       , &  ! TL Input
               iVar%FastemX_Var(i)                 , &  ! Internal variable input
               Emissivity_TL(i,:)                  , &  ! TL Output
               Reflectivity_TL(i,:)                , &  ! TL Output
               Azimuth_Angle_TL = Wind_Direction_TL, &  ! Optional TL input
               Transmittance_TL = Transmittance_TL   )  ! Optional TL input

      END DO

    ELSE

      ! Low frequency model coupled with Fastem1
      IF( iVar%Is_LOW_Freq) THEN
        ! Call the low frequency model
        DO i = 1, nZ
            CALL LowFrequency_MWSSEM_TL(              &
                 Water_Temperature_TL             , &  ! TL  Input
                 Salinity_TL                      , &  ! TL  Input
                 Wind_Speed_TL                    , &  ! TL  Input
                 Emissivity_TL(i,:)               , &  ! TL  Output
                 iVar%LF_MWSSEM_Var(i)              )  ! Internal variable input
          Reflectivity_TL(i,1) = -Emissivity_TL(i,1)
          Reflectivity_TL(i,2) = -Emissivity_TL(i,2)
        END DO
      ELSE
        ! Call Fastem1
        DO i = 1, nZ
          Emissivity_TL(i,2) = (iVar%dEH_dTs(i)*Water_Temperature_TL) + &
                                        (iVar%dEH_dWindSpeed(i)*Wind_Speed_TL)
          Emissivity_TL(i,1) = (iVar%dEV_dTs(i)*Water_Temperature_TL) + &
                                         (iVar%dEV_dWindSpeed(i)*Wind_Speed_TL)
          Reflectivity_TL(i,1) = -Emissivity_TL(i,1)
          Reflectivity_TL(i,2) = -Emissivity_TL(i,2)
        END DO
      END IF
    END IF

  END FUNCTION Compute_FASTEM_SfcOptics_TL

!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!      Compute_FASTEM_SfcOptics_AD
!
! PURPOSE:
!       Function to compute the adjoint surface emissivity and
!       reflectivity at microwave frequencies over a water surface.
!
!
!       This function is a wrapper of different FASTEM versions
!
! CALLING SEQUENCE:
!       Error_Status = Compute_FASTEM_SfcOptics_AD(
!                              Emissivity_AD                          , &  ! Output
!                              Reflectivity_AD                        , &  ! Output
!                              Water_Temperature_AD                   , &  ! Input
!                              Salinity_AD                            , &  ! Input
!                              Wind_Speed_AD                          , &  ! Input
!                              Wind_Direction_AD                      , &  ! Input
!                              iVar                                   , &  ! Input
!                              FASTEM_Version)                          &  ! Input
! INPUTS:
!
!      Emissivity_AD:    Full Stokes surface emissivity adjoint
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(INOUT)
!
!      Reflectivity_AD:  Full Stokes surface reflectivity adjoint
!                        UNITS:      N/A
!                        TYPE:       REAL
!                        DIMENSION:  Assumed-shape ARRAY
!                        ATTRIBUTES: INTENT(INOUT)

!      FASTEM_Version:   FASTEM version index
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!      iVar:             Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!
!      Water_Temperature_AD:Water surface temperature adjoint
!                        UNITS:      K
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(INOUT)
!
!      Salinity_AD:      Water salinity adjoint
!                        UNITS:      Per thousand
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(INOUT)
!
!      Wind_Speed_AD:    Ocean surface wind speed djoint
!                        UNITS:      m/s
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(INOUT)
!
!      Wind_Direction_AD:Wind direction adjoint
!                        UNITS:      Degree
!                        TYPE:       REAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(INOUT)
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the Message_Handler module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!!      Note the INTENT on the input SfcOptics_AD argument is IN OUT rather
!       than just OUT. This is necessary because components of this argument
!       may need to be zeroed out upon output.
!
!       Note the INTENT on the output Surface_AD argument is IN OUT rather
!       than just OUT. This is necessary because the argument may be defined
!       upon input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION Compute_FASTEM_SfcOptics_AD(  &
           Emissivity_AD                        , &  ! Input
           Reflectivity_AD                      , &  ! Input
           Water_Temperature_AD                 , &  ! Output
           Salinity_AD                          , &  ! Output
           Wind_Speed_AD                        , &  ! Output
           Wind_Direction_AD                    , &  ! Output
           Transmittance_AD                     , &  ! Output
           iVar                                 , &  ! InOUT
           FASTEM_Version)                        &  ! Input
  RESULT( err_stat )

    ! Arguments
    REAL(fp), INTENT(INOUT) :: Reflectivity_AD(:,:)
    REAL(fp), INTENT(INOUT) :: Emissivity_AD(:,:)
    REAL(fp), INTENT(INOUT) :: Transmittance_AD
    REAL(fp), INTENT(OUT)   :: Water_Temperature_AD
    REAL(fp), INTENT(OUT)   :: Salinity_AD
    REAL(fp), INTENT(OUT)   :: Wind_Speed_AD
    REAL(fp), INTENT(OUT)   :: Wind_Direction_AD
    INTEGER , INTENT(IN)    :: FASTEM_Version

    TYPE(iVar_type),              INTENT(IN)     :: iVar
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Compute_MW_Water_SfcOptics_AD'
    ! Local variables
    INTEGER :: i, j, nZ
    REAL(fp) :: Azimuth_Angle_AD

    ! Set up
    err_stat = SUCCESS
    nZ = size(Emissivity_AD,1)

    ! Compute the adjoint surface optical parameters
    IF(FASTEM_Version == 6 .OR. FASTEM_Version == 5) THEN

      ! FastemX model
      Azimuth_Angle_AD = ZERO
      DO i = 1, nZ
        CALL Compute_FastemX_AD( &
               MWwaterC                             , &  ! Input model coefficients
               Emissivity_AD(i,:)                   , &  ! AD Input
               Reflectivity_AD(i,:)                 , &  ! AD Input
               iVar%FastemX_Var(i)                        , &  ! Internal variable input
               Water_Temperature_AD                 , &  ! AD Output
               Salinity_AD                          , &  ! AD Output
               Wind_Speed_AD                        , &  ! AD Output
               Azimuth_Angle_AD = Azimuth_Angle_AD  , &  ! Optional AD Output
               Transmittance_AD = Transmittance_AD    )  ! Optional AD Output
      END DO
      Wind_Direction_AD = Wind_Direction_AD + Azimuth_Angle_AD

    ELSE

      ! Low frequency model coupled with Fastem1
      IF( iVar%Is_LOW_Freq ) THEN
        ! Call the low frequency model
        DO i = 1, nZ
          Emissivity_AD(i,1) = Emissivity_AD(i,1)-Reflectivity_AD(i,1)
          Emissivity_AD(i,2) = Emissivity_AD(i,2)-Reflectivity_AD(i,2)
          CALL LowFrequency_MWSSEM_AD(                &
                 Emissivity_AD(i,:)                 , &  ! AD  Input
                 Water_Temperature_AD               , &  ! AD  Output
                 Salinity_AD                        , &  ! AD  Output
                 Wind_Speed_AD                      , &  ! AD  Output
                 iVar%LF_MWSSEM_Var(i)                ) ! Internal variable input
        END DO
      ELSE
        ! Call Fastem1
        DO i = nZ, 1, -1
          DO j = 1, 2
            Emissivity_AD(i,1:2) = Emissivity_AD(i,1:2) - Reflectivity_AD(i,1:2)
            Reflectivity_AD(i,1:2) = ZERO
          END DO
          ! Vertical polarisation component
          Water_Temperature_AD  = Water_Temperature_AD + &
                                         (iVar%dEV_dTs(i)*Emissivity_AD(i,1))
          Wind_Speed_AD         = Wind_Speed_AD + &
                                         (iVar%dEV_dWindSpeed(i)*Emissivity_AD(i,1))
          Emissivity_AD(i,1)  = ZERO
          ! Horizontal polarization component
          Water_Temperature_AD  = Water_Temperature_AD + &
                                         (iVar%dEH_dTs(i)*Emissivity_AD(i,2))
          Wind_Speed_AD         = Wind_Speed_AD + &
                                         (iVar%dEH_dWindSpeed(i)*Emissivity_AD(i,2))
          Emissivity_AD(i,2)  = ZERO
        END DO
      END IF
    END IF

    Reflectivity_AD = ZERO

  END FUNCTION Compute_FASTEM_SfcOptics_AD
!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!      CRTM_FASTEM_Init
!
! PURPOSE:
!       Function to load FASTEM coefficient NETDCF files
!
!       This function must be called before calling other FASTEM functions
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_FASTEM_Init(
!                              MWwaterCoeff_File                      , &  ! Output
!                              Version)                                 &  ! Input
! INPUTS:
!
!      MWwaterCoeff_File:FASTEM coefficient file (full-path)
!                        UNITS:      N/A
!                        TYPE:       CHARACTER
!                        DIMENSION:  SCALAR
!                        ATTRIBUTES: INTENT(INOUT)
!
!
!      Version:          version index
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!
!      CSEM_MWwaterCoeff_INIT: Global-scope variable
!                        UNITS:      N/A
!                        TYPE:       LOGICAL
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: Global
!
!
! FUNCTION RESULT:
!       Error_Status:    The return value is an integer defining the error status.
!                        The error codes are defined in the Message_Handler module.
!                        If == SUCCESS the computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION CRTM_FASTEM_Init( &
    MWwaterCoeff_File,       &
    Version)                 &
  RESULT( Error_Status  )
    CHARACTER(LEN=*)  :: MWwaterCoeff_File
    INTEGER,INTENT(IN)  :: Version
    INTEGER  :: Error_Status
    LOGICAL  :: Quiet=.TRUE.
    !PRINT*, 'loading MWwaterCoeff data from '//TRIM(MWwaterCoeff_File), Version
    Error_Status = CSEM_MWwaterCoeff_Load( &
                 TRIM(MWwaterCoeff_File), &
                 Version=Version, Quiet = Quiet )

    IF ( Error_Status /= SUCCESS ) THEN
        PRINT*, 'Error loading MWwaterCoeff data from '//TRIM(MWwaterCoeff_File)
        STOP
    END IF
    MWwaterC%Version = Version
    CSEM_MWwaterCoeff_INIT = .TRUE.
  END FUNCTION CRTM_FASTEM_Init

  FUNCTION CRTM_FASTEM_Destroy () RESULT( Error_Status  )
    INTEGER  :: Error_Status
    Error_Status = SUCCESS
    !PRINT*, ' Closeing MWwaterCoeff data ....'
    IF(.NOT. CSEM_MWwaterCoeff_INIT) THEN
       RETURN
    ENDIF
    Error_Status  = CSEM_MWwaterCoeff_CleanUp( )

    IF ( Error_Status /= SUCCESS ) THEN
        PRINT*, 'Error Closeing MWwaterCoeff data ....'
        STOP
    END IF
    CSEM_MWwaterCoeff_INIT = .FALSE.
  END FUNCTION CRTM_FASTEM_Destroy

END MODULE CRTM_FASTEM_MODULE


text:
*----------------------------------------------------------------------*
      function state_label(i_state, use_1)
*----------------------------------------------------------------------*
*     return a simple label to use as a sufix for state specific
*     eneities: "_<i_state>"
*     if use_1 is false, don't use a label ("") for 1st state
*----------------------------------------------------------------------*

      implicit none
      include 'def_target.h'

      character(len_target_name) ::
     &     state_label

      integer, intent(in) ::
     &     i_state
      logical, intent(in) ::
     &     use_1

      if (i_state.eq.1.and..not.use_1) then
       state_label = ''
      else
       write(state_label, '("_",i0)') i_state
      end if

      return
      end

max_stars_repo_name: ak-ustutt/GeCCo-public

max_issues_repo_name: ak-ustutt/GeCCo-public

max_forks_repo_name: ak-ustutt/GeCCo-public


text:
Executive Alterations & Formalwear provides alterations and the renting and purchasing of formal tuxedos and accessories as well as affordable formal dresses. They can alter your existing clothing with their staff of experienced seamstresses with combined 30 years of experience.  Rush Alterations are available for an extra charge, and a variety of alterations are available, anything from hemming pants to fixing the fit of a wedding dress.

Discounts are available on Campus Special and Yelp.

Photos


text:
Jason Fisk (born September 4, 1972) is a Davis resident and retired NFL defensive lineman. He was born in Davis and played high school football at Davis Senior High School. Jason started playing for the varsity team as a sophomore, and was a superstar at DHS. He was an honorable mention AllAmerican selection by USA Today his senior year, and was named to the Sacramento Bee Sacramento Bee’s AllDecade team. Fisk started on both sides of the ball for the only Davis High School football team to win the section championship, in 1988. He also sang and danced with the DHS Jazz Choir. Fisk Graduates of the Davis Joint Unified School District graduated from Davis High School in 1990.

Fisk was given a scholarship to play football at Stanford University, where he lettered four years. He earned Pacific10 Conference AllAcademic honors as a sophomore, honorable mention AllPac10 honors as junior, and was an AllPac10 and honorable mention AllAmerican selection as senior. Fisk was a member of the Delta Tau Delta fraternity and earned degrees in biology and psychology while at Stanford.

Fisk was selected by the Minnesota Vikings with the 35th pick in the seventh round (243rd out of 249 overall) of the 1995 NFL Draft. He played for the Vikings (19951998), Tennessee Titans (19992001), San Diego Chargers (20022004), Cleveland Browns (2005) and St. Louis Rams (2006). While with the Titans, Fisk played in Super Bowl XXXIV, where he recorded a sack of MVP Kurt Warner. 2006 was Fisks twelfth NFL season, for which he signed a oneyear contract.

Jason Fisk is married to his Davis High School sweetheart, Miriam. The Fisks have two daughters, Julia and Carmen, and one son, Tucker.  He has coached the Davis Senior High School varsity DHS Football football team since the 2007 season.

http://www.drafthistory.com/years/1995.html DraftHistory.com 1995
http://www.nflplayers.com/players/player.aspx?id22512 NFLPLAYERS.com bio
http://www.nfl.com/players/playerpage/3450 NFL.com bio
http://www.masterplangroup.com/Jason%20Fisk.htm Management bio
http://scout.scout.com/a.z?s149&p8&c1&nid1811997 SCOUT.com bio
http://www.nfl.com/teams/story/STL/9485442 NFL.com St. Louis Rams Team News
http://en.wikipedia.org/wiki/Jason_Fisk Wikipedia article