Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (22 hours ago)
Author:
abarral
Message:

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/filtrez/inifgn.F90

    r5245 r5246  
    22! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004-05-19 12:53:09 lmdzadmin Exp $
    33!
    4       SUBROUTINE inifgn(dv)
    5 c 
    6 c    ...  H.Upadyaya , O.Sharma  ...
    7 c
    8       IMPLICIT NONE
    9 c
    10       include "dimensions.h"
    11       include "paramet.h"
    12       include "comgeom.h"
     4SUBROUTINE inifgn(dv)
     5  !
     6  !    ...  H.Upadyaya , O.Sharma  ...
     7  !
     8  IMPLICIT NONE
     9  !
     10  include "dimensions.h"
     11  include "paramet.h"
     12  include "comgeom.h"
    1313
    14 c
    15       REAL vec(iim,iim),vec1(iim,iim)
    16       REAL dlonu(iim),dlonv(iim)
    17       REAL du(iim),dv(iim),d(iim)
    18       REAL pi
    19       INTEGER i,j,k,imm1,nrot
    20 C
    21       include "coefils.h"
    22 c
    23       EXTERNAL SSUM, acc,eigen,jacobi
    24       REAL SSUM
    25 c
     14  !
     15  REAL :: vec(iim,iim),vec1(iim,iim)
     16  REAL :: dlonu(iim),dlonv(iim)
     17  REAL :: du(iim),dv(iim),d(iim)
     18  REAL :: pi
     19  INTEGER :: i,j,k,imm1,nrot
     20  !
     21  include "coefils.h"
     22  !
     23  EXTERNAL SSUM, acc,eigen,jacobi
     24  REAL :: SSUM
     25  !
    2626
    27       imm1  = iim -1
    28       pi = 2.* ASIN(1.)
    29 C
    30       DO 5 i=1,iim
    31        dlonu(i)=  xprimu( i )
    32        dlonv(i)=  xprimv( i )
    33    5  CONTINUE
     27  imm1  = iim -1
     28  pi = 2.* ASIN(1.)
     29  !
     30  DO i=1,iim
     31   dlonu(i)=  xprimu( i )
     32   dlonv(i)=  xprimv( i )
     33  END DO
    3434
    35       DO 12 i=1,iim
    36       sddv(i)   = SQRT(dlonv(i))
    37       sddu(i)   = SQRT(dlonu(i))
    38       unsddu(i) = 1./sddu(i)
    39       unsddv(i) = 1./sddv(i)
    40   12  CONTINUE
    41 C
    42       DO 17 j=1,iim
    43       DO 17 i=1,iim
    44       vec(i,j)     = 0.
    45       vec1(i,j)    = 0.
    46       eignfnv(i,j) = 0.
    47       eignfnu(i,j) = 0.
    48   17  CONTINUE
    49 c
    50 c
    51       eignfnv(1,1)    = -1.
    52       eignfnv(iim,1)  =  1.
    53       DO 20 i=1,imm1
    54       eignfnv(i+1,i+1)= -1.
    55       eignfnv(i,i+1)  =  1.
    56   20  CONTINUE
    57       DO 25 j=1,iim
    58       DO 25 i=1,iim
    59       eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
    60   25  CONTINUE
    61       DO 30 j=1,iim
    62       DO 30 i=1,iim
    63       eignfnu(i,j) = -eignfnv(j,i)
    64   30  CONTINUE
    65 c
     35  DO i=1,iim
     36  sddv(i)   = SQRT(dlonv(i))
     37  sddu(i)   = SQRT(dlonu(i))
     38  unsddu(i) = 1./sddu(i)
     39  unsddv(i) = 1./sddv(i)
     40  END DO
     41  !
     42  DO j=1,iim
     43  DO i=1,iim
     44  vec(i,j)     = 0.
     45  vec1(i,j)    = 0.
     46  eignfnv(i,j) = 0.
     47  eignfnu(i,j) = 0.
     48  END DO
     49  END DO
     50  !
     51  !
     52  eignfnv(1,1)    = -1.
     53  eignfnv(iim,1)  =  1.
     54  DO i=1,imm1
     55  eignfnv(i+1,i+1)= -1.
     56  eignfnv(i,i+1)  =  1.
     57  END DO
     58  DO j=1,iim
     59  DO i=1,iim
     60  eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
     61  END DO
     62  END DO
     63  DO j=1,iim
     64  DO i=1,iim
     65  eignfnu(i,j) = -eignfnv(j,i)
     66  END DO
     67  END DO
     68  !
    6669#ifdef CRAY
    67       CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
    68       CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
     70  CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
     71  CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
    6972#else
    70       DO j = 1, iim
    71       DO i = 1, iim
    72         vec (i,j) = 0.0
    73         vec1(i,j) = 0.0
    74        DO k = 1, iim
    75         vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
    76         vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
    77        ENDDO
    78       ENDDO
    79       ENDDO
     73  DO j = 1, iim
     74  DO i = 1, iim
     75    vec (i,j) = 0.0
     76    vec1(i,j) = 0.0
     77   DO k = 1, iim
     78    vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
     79    vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
     80   ENDDO
     81  ENDDO
     82  ENDDO
    8083#endif
    8184
    82 c
    83       CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
    84       CALL acc(eignfnv,d,iim)
    85       CALL eigen_sort(dv,eignfnv,iim,iim)
    86 c
    87       CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
    88       CALL acc(eignfnu,d,iim)
    89       CALL eigen_sort(du,eignfnu,iim,iim)
     85  !
     86  CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
     87  CALL acc(eignfnv,d,iim)
     88  CALL eigen_sort(dv,eignfnv,iim,iim)
     89  !
     90  CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
     91  CALL acc(eignfnu,d,iim)
     92  CALL eigen_sort(du,eignfnu,iim,iim)
    9093
    91 cc   ancienne version avec appels IMSL
    92 c
    93 c    CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
    94 c    CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
    95 c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
    96 c    CALL acc(eignfnv,d,iim)
    97 c    CALL eigen(eignfnv,dv)
    98 c
    99 c    CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
    100 c    CALL acc(eignfnu,d,iim)
    101 c    CALL eigen(eignfnu,du)
     94  !c   ancienne version avec appels IMSL
     95  !
     96  ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
     97  ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
     98  !     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
     99  ! CALL acc(eignfnv,d,iim)
     100  ! CALL eigen(eignfnv,dv)
     101  !
     102  ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
     103  ! CALL acc(eignfnu,d,iim)
     104  ! CALL eigen(eignfnu,du)
    102105
    103       RETURN
    104       END
     106  RETURN
     107END SUBROUTINE inifgn
    105108
Note: See TracChangeset for help on using the changeset viewer.