Page 1           Source Listing                  _UNNAMED_MAIN$$
2022-05-02 15:46                                 tcoeffuvt.f

      1 c **********************************************************************
      2 c **********************************************************************
      3 c *** ETKF targeting code to provide summary maps of signal variance ***
      4 c ***** (c) S.J.Majumdar, C.H.Bishop, B.J.Etherton, December 1999. *****
      5 c *************** Code developed at Penn State University **************
      6 c **********************************************************************
      7 c ********* Thanks to Bob Kohler of HRD for eigenvalue solvers *********
      8 c **********************************************************************
      9 c **********************************************************************
     10 
     11 
     12 c 3456789012345678901234567890123456789012345678901234567890123456789012
     13 
     14       double precision,allocatable::xtvec(:,:)
     15       double precision,allocatable::xtvest(:,:)
     16       double precision,allocatable::cmat(:,:)
     17       double precision,allocatable::ceval(:)
     18       double precision,allocatable::ytvec(:,:)
     19       double precision,allocatable::obs(:,:,:)
     20       double precision,allocatable::hy(:,:)
     21       double precision,allocatable::hyt(:,:)
     22       double precision,allocatable::work3(:,:)
     23       double precision,allocatable::cmat2(:,:)
     24       double precision,allocatable::cmat3(:,:)
     25 
     26       read(5,*)idim,jdim,jstr,mem,nv,ne9,ltcode,nd_sondes,   
     27      &nd_satobs200,nd_satobs500,nd_satobs850,nvtot,ndtot
     28 
     29       allocate(xtvec(ne9,mem))
     30       allocate(xtvest(ne9,mem))
     31       allocate(cmat(mem,mem))
     32       allocate(ceval(mem))
     33       allocate(ytvec(ne9,mem))
     34       allocate(obs(idim,jdim,12))
     35       allocate(hy(nvtot,mem))
     36       allocate(hyt(mem,nvtot))
     37       allocate(work3(mem,mem))
     38       allocate(cmat2(mem,mem))
     39       allocate(cmat3(mem,mem))
     40 
     41       call read_perts(xtvec,idim,jdim,mem,ne9,nv)
     42 
     43 *     &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
     44 *     New function call figures out array hy = [R^-.5][H][Zr] from
     45 *     xtvec (Zr).  Then the ceval eigenvalues and cmat eigenvectors
     46 *     from [Zr^T][H^T][R^-1][H][Zr] are calculated.  Finally, the
     47 *     transformation matrix cmat2 is calculated, then rescaled 
     48 *     to form the rescaled transformation matrix cmat3 (T).  Then,
     49 *     ytvec (Zn) is formed my multiplying xtvec (Zr) by cmat3 (T).
     50 *     &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
     51       do 125 i=1,idim
     52       do 125 j=1,jdim
     53          obs(i,j,1)=2.4**2
     54          obs(i,j,2)=2.8**2
     55          obs(i,j,3)=2.95**2
     56          obs(i,j,4)=2.4**2
     57          obs(i,j,5)=2.8**2

Page 2           Source Listing                  _UNNAMED_MAIN$$
2022-05-02 15:46                                 tcoeffuvt.f

     58          obs(i,j,6)=2.95**2
     59          obs(i,j,7)=0.8**2
     60          obs(i,j,8)=0.8**2
     61          obs(i,j,9)=1.2**2
     62          obs(i,j,10)=7.0**2
     63          obs(i,j,11)=5.0**2
     64          obs(i,j,12)=5.0**2
     65 125   continue
     66 
     67       do 111 n=1,nvtot
     68       do 111 nm=1,mem
     69          hy(n,nm)=0.0
     70 111   continue
     71  
     72       nt=nvtot
     73 
     74       call calc_rhzr(xtvec,hy,obs,ndtot,ne9,mem,nvtot,idim,jdim,
     75      &nd_sondes,nd_satobs200,nd_satobs500,nd_satobs850,nv)
     76       CALL DTRANS(nvtot,mem,hy,hyt)
     77       CALL DMRRRR(MEM,NT,HYT,MEM,NT,MEM,HY,NT,MEM,MEM,WORK3,MEM)
     78       CALL DEVCSF(MEM,WORK3,MEM,CEVAL,CMAT,MEM)
     79 
     80       do 999 ncnt1=1,mem
     81       do 999 ncnt2=1,mem
     82   	 cmat2(ncnt1,ncnt2)=cmat(ncnt1,ncnt2)/sqrt(1.+ceval(ncnt2))
     83          cmat3(ncnt1,ncnt2)=4.182*cmat2(ncnt1,ncnt2)
     84 999   continue
     85  
     86       CALL DMRRRR(NE9,MEM,XTVEC,NE9,MEM,MEM,CMAT3,MEM,NE9,MEM,YTVEC,NE9)
     87 
     88       knum1=8200+ltcode
     89       knum2=8300+ltcode
     90       knum3=8400+ltcode
     91 
     92       write(knum1) ytvec
     93       write(knum2) ceval
     94       write(knum3) cmat3
     95 
     96       STOP
     97       END

Page 3           Source Listing                  _UNNAMED_MAIN$$
2022-05-02 15:46 Entry Points                    tcoeffuvt.f



ENTRY POINTS

  Name              
                    
 MAIN__             


SYMBOL CROSS REFERENCE

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 111                        Label  70                                                             67,68                             
 125                        Label  65                                                             51,52                             
 999                        Label  84                                                             80,81                             
 CALC_RHZR                  Subr   74                                                             74                                
 CEVAL                      Local  17       R(8)            8     1     1        ALC              32,78,82,93                       
 CMAT                       Local  16       R(8)            8     2     1        ALC              31,78,82                          
 CMAT2                      Local  23       R(8)            8     2     1        ALC              38,82,83                          
 CMAT3                      Local  24       R(8)            8     2     1        ALC              39,83,86,94                       
 DEVCSF                     Subr   78                                                             78                                
 DMRRRR                     Subr   77                                                             77,86                             
 DTRANS                     Subr   76                                                             76                                
 HY                         Local  20       R(8)            8     2     1        ALC              35,69,74,76,77                    
 HYT                        Local  21       R(8)            8     2     1        ALC              36,76,77                          
 I                          Local  51       I(4)            4           scalar                    51,53,54,55,56,57,58,59,60,61,62,6
                                                                                                  3,64                              
 IDIM                       Local  26       I(4)            4           scalar                    26,34,41,51,74                    
 J                          Local  52       I(4)            4           scalar                    52,53,54,55,56,57,58,59,60,61,62,6
                                                                                                  3,64                              
 JDIM                       Local  26       I(4)            4           scalar                    26,34,41,52,74                    
 JSTR                       Local  26       I(4)            4           scalar                    26                                
 KNUM1                      Local  88       I(4)            4           scalar                    88,92                             
 KNUM2                      Local  89       I(4)            4           scalar                    89,93                             
 KNUM3                      Local  90       I(4)            4           scalar                    90,94                             
 LTCODE                     Local  26       I(4)            4           scalar                    26,88,89,90                       
 MEM                        Local  26       I(4)            4           scalar                    26,29,30,31,32,33,35,36,37,38,39,4
                                                                                                  1,68,74,76,77,78,80,81,86         
 N                          Local  67       I(4)            4           scalar                    67,69                             
 NCNT1                      Local  80       I(4)            4           scalar                    80,82,83                          
 NCNT2                      Local  81       I(4)            4           scalar                    81,82,83                          
 NDTOT                      Local  27       I(4)            4           scalar                    27,74                             
 ND_SATOBS200               Local  27       I(4)            4           scalar                    27,75                             
 ND_SATOBS500               Local  27       I(4)            4           scalar                    27,75                             
 ND_SATOBS850               Local  27       I(4)            4           scalar                    27,75                             
 ND_SONDES                  Local  26       I(4)            4           scalar                    26,75                             
 NE9                        Local  26       I(4)            4           scalar                    26,29,30,33,41,74,86              
 NM                         Local  68       I(4)            4           scalar                    68,69                             
 NT                         Local  72       I(4)            4           scalar                    72,77                             
 NV                         Local  26       I(4)            4           scalar                    26,41,75                          
 NVTOT                      Local  27       I(4)            4           scalar                    27,35,36,67,72,74,76              
 OBS                        Local  19       R(8)            8     3     1        ALC              34,53,54,55,56,57,58,59,60,61,62,6
                                                                                                  3,64,74                           
 READ_PERTS                 Subr   41                                                             41                                
 SQRT                       Func   82                                   scalar                    82                                
 WORK3                      Local  22       R(8)            8     2     1        ALC              37,77,78                          

Page 4           Source Listing                  _UNNAMED_MAIN$$
2022-05-02 15:46 Symbol Table                    tcoeffuvt.f

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 XTVEC                      Local  14       R(8)            8     2     1        ALC              29,41,74,86                       
 XTVEST                     Local  15       R(8)            8     2     1        ALC              30                                
 YTVEC                      Local  18       R(8)            8     2     1        ALC              33,86,92                          
 _UNNAMED_MAIN$$            Prog   14                                                                                               

Page 5           Source Listing                  _UNNAMED_MAIN$$
2022-05-02 15:46                                 tcoeffuvt.f

     98 
     99 ************************************************************************
    100 ************************************************************************
    101 
    102 
    103 ************************************************************************
    104 *     -----------------------------------------------------------------
    105 *     Noting that keeping a bunch of extra variables around, the time
    106 *     has come to make matrix transposes a calculates, rather than a
    107 *     stored quantity.
    108 *     -----------------------------------------------------------------
    109 ************************************************************************
    110       SUBROUTINE DTRANS(M,N,A,B)
    111 ************************************************************************
    112 
    113       double precision A(m,n)
    114       double precision B(n,m)
    115       do 1111 i=1,n
    116       do 1111 j=1,m
    117 1111  B(i,j)=A(j,i)
    118 
    119       return
    120       end


ENTRY POINTS

  Name               
                     
 dtrans_             

Page 6           Source Listing                  DTRANS
2022-05-02 15:46 Symbol Table                    tcoeffuvt.f



SYMBOL CROSS REFERENCE

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 1111                       Label  117                                                            115,116                           
 A                          Dummy  110      R(8)            8     2     0        ARG,INOUT        117                               
 B                          Dummy  110      R(8)            8     2     0        ARG,INOUT        117                               
 DTRANS                     Subr   110                                                                                              
 I                          Local  115      I(4)            4           scalar                    115,117                           
 J                          Local  116      I(4)            4           scalar                    116,117                           
 M                          Dummy  110      I(4)            4           scalar   ARG,INOUT        113,114,116                       
 N                          Dummy  110      I(4)            4           scalar   ARG,INOUT        113,114,115                       

Page 7           Source Listing                  DTRANS
2022-05-02 15:46                                 tcoeffuvt.f

    121 
    122 
    123 
    124 ************************************************************************
    125 *     -----------------------------------------------------------------
    126 *     Read in ensemble perturbations, interpolate, write matrices
    127 *     -----------------------------------------------------------------
    128       subroutine read_perts(xtvec,idim,jdim,mem,ne9,nv)
    129 *     -----------------------------------------------------------------
    130 ************************************************************************
    131       
    132       dimension datat(idim,jdim,mem,9)
    133       double precision xtvec(ne9,mem)
    134 
    135       open(93,form='unformatted')
    136       read(93) datat
    137       close(93)
    138 
    139 1234  sqrtmem=sqrt(float(mem))
    140 
    141       do 35 nm=1,mem
    142          ie1=0
    143          do 211 j=1,jdim
    144          do 211 i=1,idim
    145             do 221 iv=1,nv
    146                ie1=ie1+1
    147                xtvec(ie1,nm)=datat(i,j,nm,iv)/sqrtmem
    148 221         continue
    149 211      continue
    150 35     continue
    151 
    152       return
    153       end

Page 8           Source Listing                  READ_PERTS
2022-05-02 15:46 Entry Points                    tcoeffuvt.f



ENTRY POINTS

  Name                   
                         
 read_perts_             


SYMBOL CROSS REFERENCE

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 1234                       Label  139                                                                                              
 211                        Label  149                                                            143,144                           
 221                        Label  148                                                            145                               
 35                         Label  150                                                            141                               
 DATAT                      Local  132      R(4)            4     4     0                         136,147                           
 FLOAT                      Func   139                                  scalar                    139                               
 I                          Local  144      I(4)            4           scalar                    144,147                           
 IDIM                       Dummy  128      I(4)            4           scalar   ARG,INOUT        132,144                           
 IE1                        Local  142      I(4)            4           scalar                    142,146,147                       
 IV                         Local  145      I(4)            4           scalar                    145,147                           
 J                          Local  143      I(4)            4           scalar                    143,147                           
 JDIM                       Dummy  128      I(4)            4           scalar   ARG,INOUT        132,143                           
 MEM                        Dummy  128      I(4)            4           scalar   ARG,INOUT        132,133,139,141                   
 NE9                        Dummy  128      I(4)            4           scalar   ARG,INOUT        133                               
 NM                         Local  141      I(4)            4           scalar                    141,147                           
 NV                         Dummy  128      I(4)            4           scalar   ARG,INOUT        145                               
 READ_PERTS                 Subr   128                                                                                              
 SQRT                       Func   139                                  scalar                    139                               
 SQRTMEM                    Local  139      R(4)            4           scalar                    139,147                           
 XTVEC                      Dummy  128      R(8)            8     2     0        ARG,INOUT        147                               

Page 9           Source Listing                  READ_PERTS
2022-05-02 15:46                                 tcoeffuvt.f

    154 
    155 ************************************************************************
    156 *     ------------------------------------------------------------------
    157 *     Calculate new Z matrix for the routine component        
    158 *     ------------------------------------------------------------------
    159       subroutine calc_rhzr(xtvec,hy,obs,ndtot,ne9,mem,nvtot,idim,jdim,
    160      &nd_sondes,nd_satobs200,nd_satobs500,nd_satobs850,nv)
    161 *     ------------------------------------------------------------------ 
    162 ************************************************************************
    163 
    164       real*4 obslon(ndtot),obslat(ndtot)
    165       integer lat1(ndtot),lat2(ndtot),lon1(ndtot),lon2(ndtot)
    166       double precision xtvec(ne9,mem),hmat(ndtot,4),hy(nvtot,mem)
    167       double precision obs(idim,jdim,12)
    168       integer k 
    169 
    170 *     ----------------------------------------------------------
    171 *     Create the translation matrix from gridpoint space to
    172 *     observation space known as H.
    173 *     ----------------------------------------------------------
    174 
    175       pi=acos(-1.0)
    176       do 20 iobs=1,nd_sondes
    177          read(7,*) obslon(iobs), obslat(iobs)
    178          xlo1=int(obslon(iobs)*144./360.)*2.5
    179          xlo2=xlo1+2.5
    180          yla1=int(obslat(iobs)*72./180.)*2.5
    181          yla2=yla1+2.5
    182          zquot=(xlo2-xlo1)*(yla2-yla1)
    183          hmat(iobs,1)= (obslon(iobs)-xlo2)*(obslat(iobs)-yla2)/zquot
    184          hmat(iobs,2)=-(obslon(iobs)-xlo2)*(obslat(iobs)-yla1)/zquot
    185          hmat(iobs,3)=-(obslon(iobs)-xlo1)*(obslat(iobs)-yla2)/zquot
    186          hmat(iobs,4)= (obslon(iobs)-xlo1)*(obslat(iobs)-yla1)/zquot
    187          lon1(iobs)=nint(xlo1/2.5)+1
    188          lon2(iobs)=nint(xlo2/2.5)+1
    189             if (lon2(iobs).gt.144) then
    190                lon2(iobs)=1
    191             endif
    192          lat1(iobs)=37-nint(yla1/2.5)
    193          lat2(iobs)=37-nint(yla2/2.5)
    194 20    continue
    195       close(7)
    196 
    197       do 21 j=1,nd_satobs200
    198          k=j+nd_sondes
    199          read(91,*) obslon(k), obslat(k)
    200          xlo1=int(obslon(k)*144./360.)*2.5
    201          xlo2=xlo1+2.5
    202          yla1=int(obslat(k)*72./180.)*2.5
    203          yla2=yla1+2.5
    204          zquot=(xlo2-xlo1)*(yla2-yla1)
    205          hmat(k,1)= (obslon(k)-xlo2)*(obslat(k)-yla2)/zquot
    206          hmat(k,2)=-(obslon(k)-xlo2)*(obslat(k)-yla1)/zquot
    207          hmat(k,3)=-(obslon(k)-xlo1)*(obslat(k)-yla2)/zquot
    208          hmat(k,4)= (obslon(k)-xlo1)*(obslat(k)-yla1)/zquot
    209          lon1(k)=nint(xlo1/2.5)+1
    210          lon2(k)=nint(xlo2/2.5)+1

Page 10          Source Listing                  CALC_RHZR
2022-05-02 15:46                                 tcoeffuvt.f

    211             if (lon2(k).gt.144) then
    212                lon2(k)=1
    213             endif
    214          lat1(k)=37-nint(yla1/2.5)
    215          lat2(k)=37-nint(yla2/2.5)
    216 21     continue
    217        close(91) 
    218 
    219       do 22 j=1,nd_satobs500
    220          k=j+nd_sondes+nd_satobs200
    221          read(92,*) obslon(k), obslat(k)
    222          xlo1=int(obslon(k)*144./360.)*2.5
    223          xlo2=xlo1+2.5
    224          yla1=int(obslat(k)*72./180.)*2.5
    225          yla2=yla1+2.5
    226          zquot=(xlo2-xlo1)*(yla2-yla1)
    227          hmat(k,1)= (obslon(k)-xlo2)*(obslat(k)-yla2)/zquot
    228          hmat(k,2)=-(obslon(k)-xlo2)*(obslat(k)-yla1)/zquot
    229          hmat(k,3)=-(obslon(k)-xlo1)*(obslat(k)-yla2)/zquot
    230          hmat(k,4)= (obslon(k)-xlo1)*(obslat(k)-yla1)/zquot
    231          lon1(k)=nint(xlo1/2.5)+1
    232          lon2(k)=nint(xlo2/2.5)+1
    233             if (lon2(k).gt.144) then
    234                lon2(k)=1
    235             endif
    236          lat1(k)=37-nint(yla1/2.5)
    237          lat2(k)=37-nint(yla2/2.5)
    238 22     continue
    239        close(92)
    240 
    241       do 23 j=1,nd_satobs850
    242          k=j+nd_sondes+nd_satobs200+nd_satobs500
    243          read(90,*) obslon(k), obslat(k)
    244          xlo1=int(obslon(k)*144./360.)*2.5
    245          xlo2=xlo1+2.5
    246          yla1=int(obslat(k)*72./180.)*2.5
    247          yla2=yla1+2.5
    248          zquot=(xlo2-xlo1)*(yla2-yla1)
    249          hmat(k,1)= (obslon(k)-xlo2)*(obslat(k)-yla2)/zquot
    250          hmat(k,2)=-(obslon(k)-xlo2)*(obslat(k)-yla1)/zquot
    251          hmat(k,3)=-(obslon(k)-xlo1)*(obslat(k)-yla2)/zquot
    252          hmat(k,4)= (obslon(k)-xlo1)*(obslat(k)-yla1)/zquot
    253          lon1(k)=nint(xlo1/2.5)+1
    254          lon2(k)=nint(xlo2/2.5)+1
    255             if (lon2(k).gt.144) then
    256                lon2(k)=1
    257             endif
    258          lat1(k)=37-nint(yla1/2.5)
    259          lat2(k)=37-nint(yla2/2.5)
    260 23     continue
    261        close(90)
    262 
    263 *     --------------------------------------------------------
    264 *     Generate the nice small matrix H*Y, using our brains!
    265 *     --------------------------------------------------------
    266       do 33 nm=1,mem
    267       do 33 iobs=1,nd_sondes

Page 11          Source Listing                  CALC_RHZR
2022-05-02 15:46                                 tcoeffuvt.f

    268       do 33 iv=1,nv
    269          mm1=9*(lat1(iobs)-1)*idim + 9*(lon1(iobs)-1) + iv
    270          mm2=9*(lat2(iobs)-1)*idim + 9*(lon1(iobs)-1) + iv
    271          mm3=9*(lat1(iobs)-1)*idim + 9*(lon2(iobs)-1) + iv
    272          mm4=9*(lat2(iobs)-1)*idim + 9*(lon2(iobs)-1) + iv
    273          io=9*(iobs-1) + iv
    274       hy(io,nm)=hmat(iobs,1)*xtvec(mm1,nm)+hmat(iobs,2)*xtvec(mm2,nm)+
    275      &          hmat(iobs,3)*xtvec(mm3,nm)+hmat(iobs,4)*xtvec(mm4,nm)
    276       hy(io,nm)=hy(io,nm)/sqrt(obs(1,1,iv))
    277 33    continue
    278 
    279       do 34 nm=1,mem
    280       do 34 j=1,nd_satobs200
    281          k=j+nd_sondes
    282          mm1=9*(lat1(k)-1)*idim + 9*(lon1(k)-1) + 9
    283          mm2=9*(lat2(k)-1)*idim + 9*(lon1(k)-1) + 9
    284          mm3=9*(lat1(k)-1)*idim + 9*(lon2(k)-1) + 9
    285          mm4=9*(lat2(k)-1)*idim + 9*(lon2(k)-1) + 9
    286          io=j+nd_sondes*9
    287       hy(io,nm)=hmat(k,1)*xtvec(mm1,nm)+hmat(k,2)*xtvec(mm2,nm)+
    288      &          hmat(k,3)*xtvec(mm3,nm)+hmat(k,4)*xtvec(mm4,nm)
    289       hy(io,nm)=hy(io,nm)/sqrt(obs(1,1,12))
    290 34    continue
    291 
    292       do 35 nm=1,mem
    293       do 35 j=1,nd_satobs500
    294          k=j+nd_sondes+nd_satobs200
    295          mm1=9*(lat1(k)-1)*idim + 9*(lon1(k)-1) + 8
    296          mm2=9*(lat2(k)-1)*idim + 9*(lon1(k)-1) + 8
    297          mm3=9*(lat1(k)-1)*idim + 9*(lon2(k)-1) + 8
    298          mm4=9*(lat2(k)-1)*idim + 9*(lon2(k)-1) + 8 
    299          io=j+nd_satobs200+nd_sondes*9
    300       hy(io,nm)=hmat(k,1)*xtvec(mm1,nm)+hmat(k,2)*xtvec(mm2,nm)+
    301      &          hmat(k,3)*xtvec(mm3,nm)+hmat(k,4)*xtvec(mm4,nm)
    302       hy(io,nm)=hy(io,nm)/sqrt(obs(1,1,11))
    303 35    continue
    304 
    305       do 36 nm=1,mem
    306       do 36 j=1,nd_satobs850
    307          k=j+nd_sondes+nd_satobs200+nd_satobs500
    308          mm1=9*(lat1(k)-1)*idim + 9*(lon1(k)-1) + 7
    309          mm2=9*(lat2(k)-1)*idim + 9*(lon1(k)-1) + 7
    310          mm3=9*(lat1(k)-1)*idim + 9*(lon2(k)-1) + 7
    311          mm4=9*(lat2(k)-1)*idim + 9*(lon2(k)-1) + 7
    312          io=j+nd_satobs200+nd_satobs500+nd_sondes*9
    313       hy(io,nm)=hmat(k,1)*xtvec(mm1,nm)+hmat(k,2)*xtvec(mm2,nm)+
    314      &          hmat(k,3)*xtvec(mm3,nm)+hmat(k,4)*xtvec(mm4,nm)
    315       hy(io,nm)=hy(io,nm)/sqrt(obs(1,1,10))
    316 36    continue
    317 
    318       return
    319       end

Page 12          Source Listing                  CALC_RHZR
2022-05-02 15:46 Entry Points                    tcoeffuvt.f



ENTRY POINTS

  Name                  
                        
 calc_rhzr_             


SYMBOL CROSS REFERENCE

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 20                         Label  194                                                            176                               
 21                         Label  216                                                            197                               
 22                         Label  238                                                            219                               
 23                         Label  260                                                            241                               
 33                         Label  277                                                            266,267,268                       
 34                         Label  290                                                            279,280                           
 35                         Label  303                                                            292,293                           
 36                         Label  316                                                            305,306                           
 ACOS                       Func   175                                  scalar                    175                               
 CALC_RHZR                  Subr   159                                                                                              
 HMAT                       Local  166      R(8)            8     2     0                         183,184,185,186,205,206,207,208,22
                                                                                                  7,228,229,230,249,250,251,252,274,
                                                                                                  275,287,288,300,301,313,314       
 HY                         Dummy  159      R(8)            8     2     0        ARG,INOUT        274,276,287,289,300,302,313,315   
 IDIM                       Dummy  159      I(4)            4           scalar   ARG,INOUT        167,269,270,271,272,282,283,284,28
                                                                                                  5,295,296,297,298,308,309,310,311 
 INT                        Func   178                                  scalar                    178,180,200,202,222,224,244,246   
 IO                         Local  273      I(4)            4           scalar                    273,274,276,286,287,289,299,300,30
                                                                                                  2,312,313,315                     
 IOBS                       Local  176      I(4)            4           scalar                    176,177,178,180,183,184,185,186,18
                                                                                                  7,188,189,190,192,193,267,269,270,
                                                                                                  271,272,273,274,275               
 IV                         Local  268      I(4)            4           scalar                    268,269,270,271,272,273,276       
 J                          Local  197      I(4)            4           scalar                    197,198,219,220,241,242,280,281,28
                                                                                                  6,293,294,299,306,307,312         
 JDIM                       Dummy  159      I(4)            4           scalar   ARG,INOUT        167                               
 K                          Local  168      I(4)            4           scalar                    198,199,200,202,205,206,207,208,20
                                                                                                  9,210,211,212,214,215,220,221,222,
                                                                                                  224,227,228,229,230,231,232,233,23
                                                                                                  4,236,237,242,243,244,246,249,250,
                                                                                                  251,252,253,254,255,256,258,259,28
                                                                                                  1,282,283,284,285,287,288,294,295,
                                                                                                  296,297,298,300,301,307,308,309,31
                                                                                                  0,311,313,314                     
 LAT1                       Local  165      I(4)            4     1     0                         192,214,236,258,269,271,282,284,29
                                                                                                  5,297,308,310                     
 LAT2                       Local  165      I(4)            4     1     0                         193,215,237,259,270,272,283,285,29
                                                                                                  6,298,309,311                     
 LON1                       Local  165      I(4)            4     1     0                         187,209,231,253,269,270,282,283,29
                                                                                                  5,296,308,309                     
 LON2                       Local  165      I(4)            4     1     0                         188,189,190,210,211,212,232,233,23
                                                                                                  4,254,255,256,271,272,284,285,297,
                                                                                                  298,310,311                       
 MEM                        Dummy  159      I(4)            4           scalar   ARG,INOUT        166,266,279,292,305               

Page 13          Source Listing                  CALC_RHZR
2022-05-02 15:46 Symbol Table                    tcoeffuvt.f

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 MM1                        Local  269      I(4)            4           scalar                    269,274,282,287,295,300,308,313   
 MM2                        Local  270      I(4)            4           scalar                    270,274,283,287,296,300,309,313   
 MM3                        Local  271      I(4)            4           scalar                    271,275,284,288,297,301,310,314   
 MM4                        Local  272      I(4)            4           scalar                    272,275,285,288,298,301,311,314   
 NDTOT                      Dummy  159      I(4)            4           scalar   ARG,INOUT        164,165,166                       
 ND_SATOBS200               Dummy  160      I(4)            4           scalar   ARG,INOUT        197,220,242,280,294,299,307,312   
 ND_SATOBS500               Dummy  160      I(4)            4           scalar   ARG,INOUT        219,242,293,307,312               
 ND_SATOBS850               Dummy  160      I(4)            4           scalar   ARG,INOUT        241,306                           
 ND_SONDES                  Dummy  160      I(4)            4           scalar   ARG,INOUT        176,198,220,242,267,281,286,294,29
                                                                                                  9,307,312                         
 NE9                        Dummy  159      I(4)            4           scalar   ARG,INOUT        166                               
 NINT                       Func   187                                  scalar                    187,188,192,193,209,210,214,215,23
                                                                                                  1,232,236,237,253,254,258,259     
 NM                         Local  266      I(4)            4           scalar                    266,274,275,276,279,287,288,289,29
                                                                                                  2,300,301,302,305,313,314,315     
 NV                         Dummy  160      I(4)            4           scalar   ARG,INOUT        268                               
 NVTOT                      Dummy  159      I(4)            4           scalar   ARG,INOUT        166                               
 OBS                        Dummy  159      R(8)            8     3     0        ARG,INOUT        276,289,302,315                   
 OBSLAT                     Local  164      R(4)            4     1     0                         177,180,183,184,185,186,199,202,20
                                                                                                  5,206,207,208,221,224,227,228,229,
                                                                                                  230,243,246,249,250,251,252       
 OBSLON                     Local  164      R(4)            4     1     0                         177,178,183,184,185,186,199,200,20
                                                                                                  5,206,207,208,221,222,227,228,229,
                                                                                                  230,243,244,249,250,251,252       
 PI                         Local  175      R(4)            4           scalar                    175                               
 SQRT                       Func   276                                  scalar                    276,289,302,315                   
 XLO1                       Local  178      R(4)            4           scalar                    178,179,182,185,186,187,200,201,20
                                                                                                  4,207,208,209,222,223,226,229,230,
                                                                                                  231,244,245,248,251,252,253       
 XLO2                       Local  179      R(4)            4           scalar                    179,182,183,184,188,201,204,205,20
                                                                                                  6,210,223,226,227,228,232,245,248,
                                                                                                  249,250,254                       
 XTVEC                      Dummy  159      R(8)            8     2     0        ARG,INOUT        274,275,287,288,300,301,313,314   
 YLA1                       Local  180      R(4)            4           scalar                    180,181,182,184,186,192,202,203,20
                                                                                                  4,206,208,214,224,225,226,228,230,
                                                                                                  236,246,247,248,250,252,258       
 YLA2                       Local  181      R(4)            4           scalar                    181,182,183,185,193,203,204,205,20
                                                                                                  7,215,225,226,227,229,237,247,248,
                                                                                                  249,251,259                       
 ZQUOT                      Local  182      R(4)            4           scalar                    182,183,184,185,186,204,205,206,20
                                                                                                  7,208,226,227,228,229,230,248,249,
                                                                                                  250,251,252                       

Page 14          Source Listing                  CALC_RHZR
2022-05-02 15:46 Subprograms/Common Blocks       tcoeffuvt.f



SUBPROGRAMS/COMMON BLOCKS

 Name                       Object Declared Type            Bytes Dimen Elements Attributes       References                        
                                                                                                                                    
 CALC_RHZR                  Subr   159                                                                                              
 DTRANS                     Subr   110                                                                                              
 READ_PERTS                 Subr   128                                                                                              
 _UNNAMED_MAIN$$            Prog   14                                                                                               

COMPILER OPTIONS BEING USED

       -align noall                          -align nonone
       -align nocommons                      -align nodcommons
       -align noqcommons                     -align nozcommons
       -align records                        -align sequence
       -align norec1byte                     -align norec2byte
       -align norec4byte                     -align norec8byte
       -align norec16byte                    -align norec32byte
       -align norec64byte                    -align noarray8byte
       -align noarray16byte                  -align noarray32byte
       -align noarray64byte                  -align noarray128byte
       -align noarray256byte                 -altparam
       -assume accuracy_sensitive            -assume nobscc
       -assume nobuffered_io                 -assume nobuffered_stdout
       -assume byterecl                      -assume nocontiguous_assumed_shape
       -assume nocontiguous_pointer          -assume nocc_omp
       -assume nocstring                     -assume nodummy_aliases
       -assume nofpe_summary                 -assume noieee_fpe_flags
       -assume nominus0                      -assume noold_boz
       -assume old_complex_align             -assume old_unit_star
       -assume old_inquire_recl              -assume old_ldout_format
       -assume old_ldout_zero                -assume noold_logical_assign
       -assume noold_logical_ldio            -assume old_maxminloc
       -assume old_xor                       -assume noprotect_allocates
       -assume protect_constants             -assume noprotect_parens
       -assume split_common                  -assume source_include
       -assume nostd_intent_in               -assume std_minus0_rounding
       -assume nostd_mod_proc_name           -assume std_value
       -assume realloc_lhs                   -assume underscore
       -assume no2underscores                -assume norecursion
  no   -auto                                 -auto_scalar
  no   -bintext                              -ccdefault default
       -check noarg_temp_created             -check noassume
       -check nobounds                       -check nocontiguous
       -check noformat                       -check nooutput_conversion
       -check nooverflow                     -check nopointers
       -check noshape                        -check nostack
       -check nouninitialized                -check noudio_iostat
       -coarray-num-procs 0             no   -coarray-config-file
       -convert big_endian                   -cross_reference
       -D __INTEL_COMPILER=1910              -D __INTEL_COMPILER_UPDATE=3
       -D __unix__                           -D __unix
       -D __linux__                          -D __linux
       -D __gnu_linux__                      -D unix
       -D linux                              -D __ELF__

Page 15          Source Listing                  CALC_RHZR
2022-05-02 15:46                                 tcoeffuvt.f

       -D __x86_64                           -D __x86_64__
       -D __amd64                            -D __amd64__
       -D __INTEL_COMPILER_BUILD_DATE=20200925       -D __INTEL_OFFLOAD
       -D __MMX__                            -D __SSE__
       -D __SSE_MATH__                       -D __SSE2__
       -D __SSE2_MATH__                      -D __SSE3__
       -D __SSSE3__                          -D __SSE4_1__
       -D __SSE4_2__                         -D __POPCNT__
       -D __PCLMUL__                         -D __AES__
       -D __AVX__                            -D __F16C__
       -D __AVX_I__                          -D __RDRND__
       -D __FMA__                            -D __FP_FAST_FMA
       -D __FP_FAST_FMAF                     -D __BMI__
       -D __LZCNT__                          -D __AVX2__
       -D __haswell                          -D __haswell__
       -D __tune_haswell__                   -D __core_avx2
       -D __core_avx2__                      -D __tune_core_avx2__
       -double_size 64                  no   -d_lines
  no   -Qdyncom                              -error_limit 30
  no   -f66                             no   -f77rtl
  no   -fast                                 -fpscomp nofilesfromcmd
       -fpscomp nogeneral                    -fpscomp noioformat
       -fpscomp noldio_spacing               -fpscomp nologicals
       -fixed                           no   -fpconstant
       -fpe3                                 -fprm nearest
       -ftz                                  -fp_model precise
       -fp_model nofast                      -fp_model nostrict
       -fp_model nosource                    -fp_model nodouble
       -fp_model noextended                  -fp_model novery_fast
       -fp_model noexcept                    -fp_model nono_except
       -fp_modbits nofp_contract             -fp_modbits nono_fp_contract
       -fp_modbits nofenv_access             -fp_modbits nono_fenv_access
       -fp_modbits nocx_limited_range        -fp_modbits nono_cx_limited_range
       -fp_modbits noprec_div                -fp_modbits no_prec_div
       -fp_modbits noprec_sqrt               -fp_modbits no_prec_sqrt
       -fp_modbits ftz                       -fp_modbits nono_ftz
       -fp_modbits nointrin_limited_range       -fp_modbits nono_intrin_limited_range
       -fp_modbits notrunc_compares          -fp_modbits nono_trunc_compares
       -fp_modbits noieee_nan_compares       -fp_modbits nono_ieee_nan_compares
       -fp_modbits nohonor_f32_conversion       -fp_modbits nono_honor_f32_conversion
       -fp_modbits nohonor_f64_conversion       -fp_modbits nono_honor_f64_conversion
       -fp_modbits nono_x87_copy             -fp_modbits nono_no_x87_copy
       -fp_modbits noexception_semantics       -fp_modbits nono_exception_semantics
       -fp_modbits noprecise_libm_functions       -fp_modbits no_precise_libm_functions
       -heap_arrays 0                   no   -threadprivate_compat
       -g0                                   -iface nomixed_str_len_arg
       -iface nono_mixed_str_len_arg         -init noarrays
       -init nohuge                          -init noinfinity
       -init nominus_huge                    -init nominus_infinity
       -init nominus_tiny                    -init nonan
       -init nosnan                          -init notiny
       -init nozero                     no   -intconstant
       -integer_size 32                 no   -mixed_str_len_arg
  no   -module                               -names lowercase
  no   -noinclude                       no   -o
       -offload-build=host                   -openmp-simd
       -O3                              no   -pad_source

Page 16          Source Listing                  CALC_RHZR
2022-05-02 15:46                                 tcoeffuvt.f

       -real_size 32                    no   -recursive
       -reentrancy threaded                  -vec=simd
       -show nofullpath                      -show noinclude
       -show map                             -show options
  no   -syntax_only                     no   -threadcom
  no   -U                               no   -vms
       -w noall                              -w nonone
       -w alignments                         -w nodeclarations
       -w noexternals                        -w general
       -w noignore_bounds                    -w noignore_loc
       -w nointerfaces                       -w noshape
       -w notruncated_source                 -w uncalled
       -w uninitialized                      -w nounused
       -w usage                         no   -wrap-margins

       -includepath : /pe/intel/compilers_and_libraries_2020.4.304/linux/ipp/include/,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/intel64/,
           /usr/include/,.FOR,./.FOR,/opt/cray/pe/mpich/8.1.9/ofi/intel/19.0/include/.FOR,/pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/intel64/lp64/.FOR,
           /pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/.FOR,/pe/intel/compilers_and_libraries_2020.4.304/linux/ipp/include/.FOR,
           /pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/.FOR,/pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/.FOR,
           /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/stdlib/.FOR,/pe/intel/compilers_and_libraries_2020.4.304/linux/tbb/include/.FOR,
           /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/intel64/.FOR,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/icc/.FOR,
           /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/.FOR,/usr/lib64/gcc/x86_64-suse-linux/7/include/.FOR,
           /usr/lib64/gcc/x86_64-suse-linux/7/include-fixed/.FOR,/usr/include/.FOR,/usr/include/.FOR,/usr/include/.FOR
       -list filename : tcoeffuvt.lst
  no   -o

COMPILER: Intel(R) Fortran 19.1-1655