Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (23 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/dyn3d_common/traceurpole.f90

    r5245 r5246  
    22! $Id$
    33!
    4           subroutine traceurpole(q,masse)
     4    subroutine traceurpole(q,masse)
    55
    6           implicit none
    7      
    8       include "dimensions.h"
    9       include "paramet.h"
    10       include "comdissip.h"
    11       include "comgeom2.h"
    12       include "description.h"
     6      implicit none
     7
     8  include "dimensions.h"
     9  include "paramet.h"
     10  include "comdissip.h"
     11  include "comgeom2.h"
     12  include "description.h"
    1313
    1414
    15 c   Arguments
    16        integer iq
    17        real masse(iip1,jjp1,llm)
    18        real q(iip1,jjp1,llm)
    19        
     15  !   Arguments
     16   integer :: iq
     17   real :: masse(iip1,jjp1,llm)
     18   real :: q(iip1,jjp1,llm)
    2019
    21 c   Locals
    22       integer i,j,l
    23       real sommemassen(llm)
    24       real sommemqn(llm)
    25       real sommemasses(llm)
    26       real sommemqs(llm)
    27       real qpolen(llm),qpoles(llm)
    2820
    29    
    30 c On impose une seule valeur au pôle Sud j=jjm+1=jjp1       
    31       sommemasses=0
    32       sommemqs=0
    33           do l=1,llm
    34              do i=1,iip1         
    35                  sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
    36                  sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
    37              enddo         
    38           qpoles(l)=sommemqs(l)/sommemasses(l)
    39           enddo
     21  !   Locals
     22  integer :: i,j,l
     23  real :: sommemassen(llm)
     24  real :: sommemqn(llm)
     25  real :: sommemasses(llm)
     26  real :: sommemqs(llm)
     27  real :: qpolen(llm),qpoles(llm)
    4028
    41 c On impose une seule valeur du traceur au pôle Nord j=1
    42       sommemassen=0
    43       sommemqn=0 
    44          do l=1,llm
    45            do i=1,iip1             
    46                sommemassen(l)=sommemassen(l)+masse(i,1,l)
    47                sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
    48            enddo
    49            qpolen(l)=sommemqn(l)/sommemassen(l)
     29
     30  ! On impose une seule valeur au pôle Sud j=jjm+1=jjp1
     31  sommemasses=0
     32  sommemqs=0
     33      do l=1,llm
     34         do i=1,iip1
     35             sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
     36             sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
    5037         enddo
    51    
    52 c On force le traceur à prendre cette valeur aux pôles
    53         do l=1,llm
    54             do i=1,iip1
    55                q(i,1,l)=qpolen(l)
    56                q(i,jjp1,l)=qpoles(l)
    57              enddo
    58         enddo
     38      qpoles(l)=sommemqs(l)/sommemasses(l)
     39      enddo
    5940
    60      
    61       return
    62       end           
     41  ! On impose une seule valeur du traceur au pôle Nord j=1
     42  sommemassen=0
     43  sommemqn=0
     44     do l=1,llm
     45       do i=1,iip1
     46           sommemassen(l)=sommemassen(l)+masse(i,1,l)
     47           sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
     48       enddo
     49       qpolen(l)=sommemqn(l)/sommemassen(l)
     50     enddo
     51
     52  ! On force le traceur à prendre cette valeur aux pôles
     53    do l=1,llm
     54        do i=1,iip1
     55           q(i,1,l)=qpolen(l)
     56           q(i,jjp1,l)=qpoles(l)
     57         enddo
     58    enddo
     59
     60
     61  return
     62end subroutine traceurpole
Note: See TracChangeset for help on using the changeset viewer.