Ignore:
Timestamp:
Jul 23, 2024, 8:22:55 AM (2 months ago)
Author:
abarral
Message:

Handle DEBUG_IO in lmdz_cppkeys_wrapper.F90
Transform some files .F -> .[fF]90
[ne compile pas à cause de writefield_u non défini - en attente de réponse Laurent]

File:
1 moved

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90

    r5100 r5101  
    11MODULE call_dissip_mod
    22
    3     REAL,POINTER,SAVE :: ucov(:,:)
    4     REAL,POINTER,SAVE :: vcov(:,:)
    5     REAL,POINTER,SAVE :: teta(:,:)
    6     REAL,POINTER,SAVE :: p(:,: )
    7     REAL,POINTER,SAVE :: pk(:,:)
    8 
    9     REAL,POINTER,SAVE :: ucont(:,:)
    10     REAL,POINTER,SAVE :: vcont(:,:)
    11     REAL,POINTER,SAVE :: ecin(:,:)
    12     REAL,POINTER,SAVE :: ecin0(:,:)
    13     REAL,POINTER,SAVE :: dudis(:,:)
    14     REAL,POINTER,SAVE :: dvdis(:,:)
    15     REAL,POINTER,SAVE :: dtetadis(:,:)
    16     REAL,POINTER,SAVE :: dtetaecdt(:,:)
    17 
     3  REAL, POINTER, SAVE :: ucov(:, :)
     4  REAL, POINTER, SAVE :: vcov(:, :)
     5  REAL, POINTER, SAVE :: teta(:, :)
     6  REAL, POINTER, SAVE :: p(:, :)
     7  REAL, POINTER, SAVE :: pk(:, :)
     8
     9  REAL, POINTER, SAVE :: ucont(:, :)
     10  REAL, POINTER, SAVE :: vcont(:, :)
     11  REAL, POINTER, SAVE :: ecin(:, :)
     12  REAL, POINTER, SAVE :: ecin0(:, :)
     13  REAL, POINTER, SAVE :: dudis(:, :)
     14  REAL, POINTER, SAVE :: dvdis(:, :)
     15  REAL, POINTER, SAVE :: dtetadis(:, :)
     16  REAL, POINTER, SAVE :: dtetaecdt(:, :)
    1817
    1918
    2019CONTAINS
    21  
     20
    2221  SUBROUTINE call_dissip_allocate
    23   USE bands
    24   USE allocate_field_mod
    25   USE parallel_lmdz
    26   USE dimensions_mod
    27   USE dissip_mod, ONLY : dissip_allocate
    28   IMPLICIT NONE
    29     TYPE(distrib),POINTER :: d
    30     d=>distrib_dissip
    31 
    32     CALL allocate_u(ucov,llm,d)
    33     ucov(:,:)=0
    34     CALL allocate_v(vcov,llm,d)
    35     vcov(:,:)=0
    36     CALL allocate_u(teta,llm,d)
    37     CALL allocate_u(p,llmp1,d)
    38     CALL allocate_u(pk,llm,d)
    39     CALL allocate_u(ucont,llm,d)
    40     CALL allocate_v(vcont,llm,d)
    41     CALL allocate_u(ecin,llm,d)
    42     CALL allocate_u(ecin0,llm,d)
    43     CALL allocate_u(dudis,llm,d)
    44     CALL allocate_v(dvdis,llm,d)
    45     CALL allocate_u(dtetadis,llm,d)
    46     CALL allocate_u(dtetaecdt,llm,d)
    47    
    48    
     22    USE bands
     23    USE allocate_field_mod
     24    USE parallel_lmdz
     25    USE dimensions_mod
     26    USE dissip_mod, ONLY: dissip_allocate
     27    IMPLICIT NONE
     28    TYPE(distrib), POINTER :: d
     29    d => distrib_dissip
     30
     31    CALL allocate_u(ucov, llm, d)
     32    ucov(:, :) = 0
     33    CALL allocate_v(vcov, llm, d)
     34    vcov(:, :) = 0
     35    CALL allocate_u(teta, llm, d)
     36    CALL allocate_u(p, llmp1, d)
     37    CALL allocate_u(pk, llm, d)
     38    CALL allocate_u(ucont, llm, d)
     39    CALL allocate_v(vcont, llm, d)
     40    CALL allocate_u(ecin, llm, d)
     41    CALL allocate_u(ecin0, llm, d)
     42    CALL allocate_u(dudis, llm, d)
     43    CALL allocate_v(dvdis, llm, d)
     44    CALL allocate_u(dtetadis, llm, d)
     45    CALL allocate_u(dtetaecdt, llm, d)
     46
    4947    CALL dissip_allocate
    50    
     48
    5149  END SUBROUTINE call_dissip_allocate
    52  
     50
    5351  SUBROUTINE call_dissip_switch_dissip(dist)
    54   USE allocate_field_mod
    55   USE bands
    56   USE parallel_lmdz
    57   USE dissip_mod, ONLY : dissip_switch_dissip
    58   IMPLICIT NONE
    59     TYPE(distrib),INTENT(IN) :: dist
    60 
    61     CALL switch_u(ucov,distrib_dissip,dist)
    62     CALL switch_v(vcov,distrib_dissip,dist)
    63     CALL switch_u(teta,distrib_dissip,dist)
    64     CALL switch_u(p,distrib_dissip,dist)
    65     CALL switch_u(pk,distrib_dissip,dist)
    66     CALL switch_u(ucont,distrib_dissip,dist)
    67     CALL switch_v(vcont,distrib_dissip,dist)
    68     CALL switch_u(ecin,distrib_dissip,dist)
    69     CALL switch_u(ecin0,distrib_dissip,dist)
    70     CALL switch_u(dudis,distrib_dissip,dist)
    71     CALL switch_v(dvdis,distrib_dissip,dist)
    72     CALL switch_u(dtetadis,distrib_dissip,dist)
    73     CALL switch_u(dtetaecdt,distrib_dissip,dist)
     52    USE allocate_field_mod
     53    USE bands
     54    USE parallel_lmdz
     55    USE dissip_mod, ONLY: dissip_switch_dissip
     56    IMPLICIT NONE
     57    TYPE(distrib), INTENT(IN) :: dist
     58
     59    CALL switch_u(ucov, distrib_dissip, dist)
     60    CALL switch_v(vcov, distrib_dissip, dist)
     61    CALL switch_u(teta, distrib_dissip, dist)
     62    CALL switch_u(p, distrib_dissip, dist)
     63    CALL switch_u(pk, distrib_dissip, dist)
     64    CALL switch_u(ucont, distrib_dissip, dist)
     65    CALL switch_v(vcont, distrib_dissip, dist)
     66    CALL switch_u(ecin, distrib_dissip, dist)
     67    CALL switch_u(ecin0, distrib_dissip, dist)
     68    CALL switch_u(dudis, distrib_dissip, dist)
     69    CALL switch_v(dvdis, distrib_dissip, dist)
     70    CALL switch_u(dtetadis, distrib_dissip, dist)
     71    CALL switch_u(dtetaecdt, distrib_dissip, dist)
    7472
    7573    CALL dissip_switch_dissip(dist)
    76    
    77   END SUBROUTINE call_dissip_switch_dissip 
    78  
    79 
    80  
    81   SUBROUTINE call_dissip(ucov_dyn,vcov_dyn,teta_dyn,p_dyn,pk_dyn,ps_dyn)
    82   USE dimensions_mod
    83   USE parallel_lmdz
    84   USE times
    85   USE mod_hallo
    86   USE Bands
    87   USE vampir
    88   USE write_field_loc
    89   IMPLICIT NONE
     74
     75  END SUBROUTINE call_dissip_switch_dissip
     76
     77
     78  SUBROUTINE call_dissip(ucov_dyn, vcov_dyn, teta_dyn, p_dyn, pk_dyn, ps_dyn)
     79    USE dimensions_mod
     80    USE parallel_lmdz
     81    USE times
     82    USE mod_hallo
     83    USE Bands
     84    USE vampir
     85    USE write_field_loc
     86    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
     87
     88    IMPLICIT NONE
    9089    INCLUDE 'comgeom.h'
    91     REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
    92     REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
    93     REAL,INTENT(INOUT) :: teta_dyn(ijb_u:ije_u,llm) ! covariant meridional wind
    94     REAL,INTENT(INOUT) :: p_dyn(ijb_u:ije_u,llmp1 ) ! pressure at interlayer
    95     REAL,INTENT(INOUT) :: pk_dyn(ijb_u:ije_u,llm) ! Exner at midlayer
    96     REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
    97     REAL :: tppn(iim),tpps(iim)
    98     REAL :: tpn,tps
     90    REAL, INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u, llm) ! covariant zonal wind
     91    REAL, INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v, llm) ! covariant meridional wind
     92    REAL, INTENT(INOUT) :: teta_dyn(ijb_u:ije_u, llm) ! covariant meridional wind
     93    REAL, INTENT(INOUT) :: p_dyn(ijb_u:ije_u, llmp1) ! pressure at interlayer
     94    REAL, INTENT(INOUT) :: pk_dyn(ijb_u:ije_u, llm) ! Exner at midlayer
     95    REAL, INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
     96    REAL :: tppn(iim), tpps(iim)
     97    REAL :: tpn, tps
    9998
    10099    REAL  SSUM
    101     LOGICAL,PARAMETER :: dissip_conservative=.TRUE.
    102     TYPE(Request),SAVE :: Request_dissip
    103 !$OMP THREADPRIVATE(Request_dissip )   
    104     INTEGER :: ij,l,ijb,ije
    105  
    106    
    107   !$OMP MASTER
     100    LOGICAL, PARAMETER :: dissip_conservative = .TRUE.
     101    TYPE(Request), SAVE :: Request_dissip
     102    !$OMP THREADPRIVATE(Request_dissip )
     103    INTEGER :: ij, l, ijb, ije
     104
     105
     106    !$OMP MASTER
    108107    CALL suspend_timer(timer_caldyn)
    109        
    110 !       print*,'Entree dans la dissipation : Iteration No ',true_itau
    111 !   calcul de l'energie cinetique avant dissipation
    112 !       print *,'Passage dans la dissipation'
     108
     109    !       print*,'Entree dans la dissipation : Iteration No ',true_itau
     110    !   calcul de l'energie cinetique avant dissipation
     111    !       print *,'Passage dans la dissipation'
    113112
    114113    CALL VTb(VThallo)
    115   !$OMP END MASTER
    116 
    117   !$OMP BARRIER
    118 
    119     CALL Register_SwapField_u(ucov_dyn,ucov,distrib_dissip, Request_dissip,up=1,down=1)
    120     CALL Register_SwapField_v(vcov_dyn,vcov,distrib_dissip, Request_dissip,up=1,down=1)
    121     CALL Register_SwapField_u(teta_dyn,teta,distrib_dissip, Request_dissip)
    122     CALL Register_SwapField_u(p_dyn,p,distrib_dissip,Request_dissip)
    123     CALL Register_SwapField_u(pk_dyn,pk,distrib_dissip,Request_dissip)
    124 
    125     CALL SendRequest(Request_dissip)       
    126   !$OMP BARRIER
    127     CALL WaitRequest(Request_dissip)       
    128 
    129   !$OMP BARRIER
    130   !$OMP MASTER
     114    !$OMP END MASTER
     115
     116    !$OMP BARRIER
     117
     118    CALL Register_SwapField_u(ucov_dyn, ucov, distrib_dissip, Request_dissip, up = 1, down = 1)
     119    CALL Register_SwapField_v(vcov_dyn, vcov, distrib_dissip, Request_dissip, up = 1, down = 1)
     120    CALL Register_SwapField_u(teta_dyn, teta, distrib_dissip, Request_dissip)
     121    CALL Register_SwapField_u(p_dyn, p, distrib_dissip, Request_dissip)
     122    CALL Register_SwapField_u(pk_dyn, pk, distrib_dissip, Request_dissip)
     123
     124    CALL SendRequest(Request_dissip)
     125    !$OMP BARRIER
     126    CALL WaitRequest(Request_dissip)
     127
     128    !$OMP BARRIER
     129    !$OMP MASTER
    131130    CALL set_distrib(distrib_dissip)
    132131    CALL VTe(VThallo)
    133132    CALL VTb(VTdissipation)
    134133    CALL start_timer(timer_dissip)
    135   !$OMP END MASTER
    136   !$OMP BARRIER
    137 
    138     CALL covcont_loc(llm,ucov,vcov,ucont,vcont)
    139     CALL enercin_loc(vcov,ucov,vcont,ucont,ecin0)
    140 
    141 !   dissipation
    142 
    143 !        CALL FTRACE_REGION_BEGIN("dissip")
    144     CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
    145 
    146 #ifdef DEBUG_IO   
    147     CALL WriteField_u('dudis',dudis)
    148     CALL WriteField_v('dvdis',dvdis)
    149     CALL WriteField_u('dtetadis',dtetadis)
    150 #endif
    151  
    152 !      CALL FTRACE_REGION_END("dissip")
    153          
    154     ijb=ij_begin
    155     ije=ij_end
    156   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    157     DO l=1,llm
    158       ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
     134    !$OMP END MASTER
     135    !$OMP BARRIER
     136
     137    CALL covcont_loc(llm, ucov, vcov, ucont, vcont)
     138    CALL enercin_loc(vcov, ucov, vcont, ucont, ecin0)
     139
     140    !   dissipation
     141
     142    !        CALL FTRACE_REGION_BEGIN("dissip")
     143    CALL dissip_loc(vcov, ucov, teta, p, dvdis, dudis, dtetadis)
     144
     145    IF (CPPKEY_DEBUGIO) THEN
     146      CALL WriteField_u('dudis', dudis)
     147      CALL WriteField_v('dvdis', dvdis)
     148      CALL WriteField_u('dtetadis', dtetadis)
     149    END IF
     150
     151    !      CALL FTRACE_REGION_END("dissip")
     152
     153    ijb = ij_begin
     154    ije = ij_end
     155    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     156    DO l = 1, llm
     157      ucov(ijb:ije, l) = ucov(ijb:ije, l) + dudis(ijb:ije, l)
    159158    ENDDO
    160   !$OMP END DO NOWAIT       
    161 
    162     IF (pole_sud) ije=ije-iip1
    163    
    164   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    165     DO l=1,llm
    166       vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
     159    !$OMP END DO NOWAIT
     160
     161    IF (pole_sud) ije = ije - iip1
     162
     163    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     164    DO l = 1, llm
     165      vcov(ijb:ije, l) = vcov(ijb:ije, l) + dvdis(ijb:ije, l)
    167166    ENDDO
    168   !$OMP END DO NOWAIT       
    169 
    170 !       teta=teta+dtetadis
    171 
    172 
    173 !------------------------------------------------------------------------
     167    !$OMP END DO NOWAIT
     168
     169    !       teta=teta+dtetadis
     170
     171
     172    !------------------------------------------------------------------------
    174173    IF (dissip_conservative) THEN
    175 !       On rajoute la tendance due a la transform. Ec -> E therm. cree
    176 !       lors de la dissipation
    177     !$OMP BARRIER
    178     !$OMP MASTER
     174      !       On rajoute la tendance due a la transform. Ec -> E therm. cree
     175      !       lors de la dissipation
     176      !$OMP BARRIER
     177      !$OMP MASTER
    179178      CALL suspend_timer(timer_dissip)
    180179      CALL VTb(VThallo)
    181     !$OMP END MASTER
    182       CALL Register_Hallo_u(ucov,llm,1,1,1,1,Request_Dissip)
    183       CALL Register_Hallo_v(vcov,llm,1,1,1,1,Request_Dissip)
     180      !$OMP END MASTER
     181      CALL Register_Hallo_u(ucov, llm, 1, 1, 1, 1, Request_Dissip)
     182      CALL Register_Hallo_v(vcov, llm, 1, 1, 1, 1, Request_Dissip)
    184183      CALL SendRequest(Request_Dissip)
    185     !$OMP BARRIER
     184      !$OMP BARRIER
    186185      CALL WaitRequest(Request_Dissip)
    187     !$OMP MASTER
     186      !$OMP MASTER
    188187      CALL VTe(VThallo)
    189188      CALL resume_timer(timer_dissip)
    190     !$OMP END MASTER
    191     !$OMP BARRIER           
    192       CALL covcont_loc(llm,ucov,vcov,ucont,vcont)
    193       CALL enercin_loc(vcov,ucov,vcont,ucont,ecin)
    194            
    195       ijb=ij_begin
    196       ije=ij_end
    197     !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    198       DO l=1,llm
    199         DO ij=ijb,ije
    200            dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
    201            dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
     189      !$OMP END MASTER
     190      !$OMP BARRIER
     191      CALL covcont_loc(llm, ucov, vcov, ucont, vcont)
     192      CALL enercin_loc(vcov, ucov, vcont, ucont, ecin)
     193
     194      ijb = ij_begin
     195      ije = ij_end
     196      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     197      DO l = 1, llm
     198        DO ij = ijb, ije
     199          dtetaecdt(ij, l) = (ecin0(ij, l) - ecin(ij, l)) / pk(ij, l)
     200          dtetadis(ij, l) = dtetadis(ij, l) + dtetaecdt(ij, l)
    202201        ENDDO
    203202      ENDDO
    204     !$OMP END DO NOWAIT           
     203      !$OMP END DO NOWAIT
    205204
    206205    ENDIF
    207206
    208     ijb=ij_begin
    209     ije=ij_end
    210 
    211   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    212     DO l=1,llm
    213       DO ij=ijb,ije
    214          teta(ij,l)=teta(ij,l)+dtetadis(ij,l)
     207    ijb = ij_begin
     208    ije = ij_end
     209
     210    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     211    DO l = 1, llm
     212      DO ij = ijb, ije
     213        teta(ij, l) = teta(ij, l) + dtetadis(ij, l)
    215214      ENDDO
    216215    ENDDO
    217   !$OMP END DO NOWAIT         
    218 
    219 !------------------------------------------------------------------------
    220 
    221 
    222 !    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
    223 !   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
    224 
    225     ijb=ij_begin
    226     ije=ij_end
    227          
     216    !$OMP END DO NOWAIT
     217
     218    !------------------------------------------------------------------------
     219
     220
     221    !    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
     222    !   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
     223
     224    ijb = ij_begin
     225    ije = ij_end
     226
    228227    IF (pole_nord) THEN
    229  
    230    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    231       DO l  = 1, llm
    232         DO ij =  1,iim
    233           tppn(ij)  = aire(  ij    ) * teta(  ij    ,l)
    234         ENDDO
    235         tpn  = SSUM(iim,tppn,1)/apoln
     228
     229      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     230      DO l = 1, llm
     231        DO ij = 1, iim
     232          tppn(ij) = aire(ij) * teta(ij, l)
     233        ENDDO
     234        tpn = SSUM(iim, tppn, 1) / apoln
    236235
    237236        DO ij = 1, iip1
    238           teta(  ij    ,l) = tpn
     237          teta(ij, l) = tpn
    239238        ENDDO
    240239      ENDDO
    241     !$OMP END DO NOWAIT
    242 
    243          if (1 == 0) then
    244 !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
    245 !!!                     2) should probably not be here anyway
    246 !!! but are kept for those who would want to revert to previous behaviour
    247     !$OMP MASTER               
    248       DO ij =  1,iim
    249         tppn(ij)  = aire(  ij    ) * ps_dyn (  ij    )
     240      !$OMP END DO NOWAIT
     241
     242      if (1 == 0) then
     243        !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
     244        !!!                     2) should probably not be here anyway
     245        !!! but are kept for those who would want to revert to previous behaviour
     246        !$OMP MASTER
     247        DO ij = 1, iim
     248          tppn(ij) = aire(ij) * ps_dyn (ij)
     249        ENDDO
     250        tpn = SSUM(iim, tppn, 1) / apoln
     251
     252        DO ij = 1, iip1
     253          ps_dyn(ij) = tpn
     254        ENDDO
     255        !$OMP END MASTER
     256
     257      ENDIF ! of if (1 == 0)
     258    endif ! of of (pole_nord)
     259
     260    IF (pole_sud) THEN
     261
     262      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     263      DO l = 1, llm
     264        DO ij = 1, iim
     265          tpps(ij) = aire(ij + ip1jm) * teta(ij + ip1jm, l)
     266        ENDDO
     267
     268        tps = SSUM(iim, tpps, 1) / apols
     269
     270        DO ij = 1, iip1
     271          teta(ij + ip1jm, l) = tps
     272        ENDDO
    250273      ENDDO
    251       tpn  = SSUM(iim,tppn,1)/apoln
    252  
    253       DO ij = 1, iip1
    254         ps_dyn(  ij    ) = tpn
    255       ENDDO
    256     !$OMP END MASTER
    257    
    258     ENDIF ! of if (1 == 0)
    259     endif ! of of (pole_nord)
    260        
    261     IF (pole_sud) THEN
    262 
    263     !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    264       DO l  =  1, llm
    265         DO ij =  1,iim
    266           tpps(ij)  = aire(ij+ip1jm) * teta(ij+ip1jm,l)
    267         ENDDO
    268        
    269         tps  = SSUM(iim,tpps,1)/apols
     274      !$OMP END DO NOWAIT
     275
     276      if (1 == 0) then
     277        !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
     278        !!!                     2) should probably not be here anyway
     279        !!! but are kept for those who would want to revert to previous behaviour
     280        !$OMP MASTER
     281        DO ij = 1, iim
     282          tpps(ij) = aire(ij + ip1jm) * ps_dyn (ij + ip1jm)
     283        ENDDO
     284        tps = SSUM(iim, tpps, 1) / apols
    270285
    271286        DO ij = 1, iip1
    272           teta(ij+ip1jm,l) = tps
    273         ENDDO
    274       ENDDO
    275     !$OMP END DO NOWAIT
    276 
    277     if (1 == 0) then
    278 !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
    279 !!!                     2) should probably not be here anyway
    280 !!! but are kept for those who would want to revert to previous behaviour
    281     !$OMP MASTER               
    282       DO ij =  1,iim
    283         tpps(ij)  = aire(ij+ip1jm) * ps_dyn (ij+ip1jm)
    284       ENDDO
    285       tps  = SSUM(iim,tpps,1)/apols
    286  
    287       DO ij = 1, iip1
    288         ps_dyn(ij+ip1jm) = tps
    289       ENDDO
    290     !$OMP END MASTER
    291     ENDIF ! of if (1 == 0)
     287          ps_dyn(ij + ip1jm) = tps
     288        ENDDO
     289        !$OMP END MASTER
     290      ENDIF ! of if (1 == 0)
    292291    endif ! of if (pole_sud)
    293292
    294293
    295   !$OMP BARRIER
    296   !$OMP MASTER
     294    !$OMP BARRIER
     295    !$OMP MASTER
    297296    CALL VTe(VTdissipation)
    298297    CALL stop_timer(timer_dissip)
    299298    CALL VTb(VThallo)
    300   !$OMP END MASTER
    301  
    302     CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_dissip)
    303     CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_dissip)
    304     CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_dissip)
    305     CALL Register_SwapField_u(p,p_dyn,distrib_caldyn,Request_dissip)
    306     CALL Register_SwapField_u(pk,pk_dyn,distrib_caldyn,Request_dissip)
    307 
    308     CALL SendRequest(Request_dissip)       
    309 
    310   !$OMP BARRIER
    311     CALL WaitRequest(Request_dissip)       
    312   !$OMP BARRIER
    313   !$OMP MASTER
     299    !$OMP END MASTER
     300
     301    CALL Register_SwapField_u(ucov, ucov_dyn, distrib_caldyn, Request_dissip)
     302    CALL Register_SwapField_v(vcov, vcov_dyn, distrib_caldyn, Request_dissip)
     303    CALL Register_SwapField_u(teta, teta_dyn, distrib_caldyn, Request_dissip)
     304    CALL Register_SwapField_u(p, p_dyn, distrib_caldyn, Request_dissip)
     305    CALL Register_SwapField_u(pk, pk_dyn, distrib_caldyn, Request_dissip)
     306
     307    CALL SendRequest(Request_dissip)
     308
     309    !$OMP BARRIER
     310    CALL WaitRequest(Request_dissip)
     311    !$OMP BARRIER
     312    !$OMP MASTER
    314313    CALL set_distrib(distrib_caldyn)
    315314    CALL VTe(VThallo)
    316315    CALL resume_timer(timer_caldyn)
    317 !        print *,'fin dissipation'
    318   !$OMP END MASTER
    319   !$OMP BARRIER
    320  
    321  
     316    !        print *,'fin dissipation'
     317    !$OMP END MASTER
     318    !$OMP BARRIER
     319
    322320  END SUBROUTINE call_dissip
    323321
Note: See TracChangeset for help on using the changeset viewer.