Ignore:
Timestamp:
Apr 9, 2009, 12:11:35 PM (15 years ago)
Author:
Laurent Fairhead
Message:

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF

Location:
LMDZ4/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F

    r1000 r1146  
    44c
    55c
    6 #define IO_DEBUG
    7 
    8 #undef CPP_IOIPSL
    9 #define CPP_IOIPSL
    10 
    11       SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     6
     7      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    128     &                    time_0)
    139
    … …  
    2117       USE vampir
    2218       USE timer_filtre, ONLY : print_filtre_timer
     19       USE infotrac
    2320
    2421      IMPLICIT NONE
    … …  
    6966#include "com_io_dyn.h"
    7067#include "iniprint.h"
    71 
    72 c#include "tracstoke.h"
    73 
    7468#include "academic.h"
    75 !#include "clesphys.h"
    76 #include "advtrac.h"
    7769     
    78       integer nq
    79 
    8070      INTEGER         longcles
    8171      PARAMETER     ( longcles = 20 )
    … …  
    8878      REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    8979      REAL :: teta(ip1jmp1,llm)                 ! temperature potentielle
    90       REAL :: q(ip1jmp1,llm,nqmx)               ! champs advectes
     80      REAL :: q(ip1jmp1,llm,nqtot)              ! champs advectes
    9181      REAL :: ps(ip1jmp1)                       ! pression  au sol
    9282      REAL,SAVE :: p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    10999c   tendances dynamiques
    110100      REAL,SAVE :: dv(ip1jm,llm),du(ip1jmp1,llm)
    111       REAL,SAVE :: dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
     101      REAL,SAVE :: dteta(ip1jmp1,llm),dp(ip1jmp1)
     102      REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
    112103
    113104c   tendances de la dissipation
    … …  
    118109      REAL,SAVE :: dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
    119110      REAL,SAVE :: dtetafi(ip1jmp1,llm)
    120       REAL,SAVE :: dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
     111      REAL,SAVE :: dpfi(ip1jmp1)
     112      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
    121113
    122114c   variables pour le fichier histoire
    … …  
    186178      type(Request) :: Request_physic
    187179      REAL,SAVE :: dvfi_tmp(iip1,llm),dufi_tmp(iip1,llm)
    188       REAL,SAVE :: dtetafi_tmp(iip1,llm),dqfi_tmp(iip1,llm,nqmx)
     180      REAL,SAVE :: dtetafi_tmp(iip1,llm)
     181      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi_tmp
    189182      REAL,SAVE :: dpfi_tmp(iip1)
    190183
    … …  
    195188      INTEGER :: var_time
    196189      LOGICAL :: ok_start_timer=.FALSE.
     190      LOGICAL, SAVE :: firstcall=.TRUE.
    197191
    198192c$OMP MASTER
    … …  
    208202      itaufin   = nday*day_step
    209203      itaufinp1 = itaufin +1
    210 
     204      modname="leapfrog_p"
    211205
    212206      itau = 0
    … …  
    217211          iday = iday+1
    218212         ENDIF
     213
     214c Allocate variables depending on dynamic variable nqtot
     215c$OMP MASTER
     216         IF (firstcall) THEN
     217            firstcall=.FALSE.
     218            ALLOCATE(dq(ip1jmp1,llm,nqtot))
     219            ALLOCATE(dqfi(ip1jmp1,llm,nqtot))
     220            ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
     221         END IF
     222c$OMP END MASTER     
     223c$OMP BARRIER
    219224
    220225c-----------------------------------------------------------------------
    … …  
    276281c$OMP BARRIER
    277282       else
    278          
     283! Save fields obtained at previous time step as '...m1'
    279284         ijb=ij_begin
    280285         ije=ij_end
    … …  
    303308     .                    llm, -2,2, .TRUE., 1 )
    304309
    305        endif
     310       endif ! of if (FirstCaldyn)
    306311       
    307312      forward = .TRUE.
    … …  
    347352         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
    348353         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward
    349      s          .and. iflag_phys.NE.0                 ) apphys = .TRUE.
     354     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
    350355      ELSE
    351356         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
    352357         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
    353          IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.NE.0) apphys=.TRUE.
     358         IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE.
    354359      END IF
    355360
    … …  
    455460     &                                jj_Nb_caldyn,0,0,TestRequest)
    456461 
    457         do j=1,nqmx
     462        do j=1,nqtot
    458463         call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    459464     &                                jj_nb_caldyn,0,0,TestRequest)
    … …  
    490495       call Register_Hallo(p,ip1jmp1,llmp1,1,1,1,1,TestRequest)
    491496       
    492 c       do j=1,nqmx
     497c       do j=1,nqtot
    493498c         call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
    494499c     *                       TestRequest)
    … …  
    516521        call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
    517522        call WriteField_p('phis',reshape(phis,(/iip1,jmp1/)))
    518         do j=1,nqmx
     523        do j=1,nqtot
    519524          call WriteField_p('q'//trim(int2str(j)),
    520525     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    528533
    529534c$OMP MASTER
    530       print*,"Iteration No",True_itau
     535      IF (prt_level>9) THEN
     536        WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau
     537      ENDIF
    531538
    532539
    … …  
    585592
    586593
    587          ENDIF
    588 c
    589       ENDIF
     594         ENDIF ! of IF (offline)
     595c
     596      ENDIF ! of IF( forward. OR . leapf )
    590597cc$OMP END PARALLEL
    591598
    … …  
    608615c$OMP BARRIER
    609616!       CALL FTRACE_REGION_BEGIN("integrd")
     617
    610618       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    611619     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    … …  
    625633c
    626634c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
    627 c      do j=1,nqmx
     635c      do j=1,nqtot
    628636c        call WriteField_p('q'//trim(int2str(j)),
    629637c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    663671c$OMP MASTER
    664672         call suspend_timer(timer_caldyn)
    665          print*,'Entree dans la physique : Iteration No ',true_itau
     673
     674         write(lunout,*)
     675     &   'leapfrog_p: Entree dans la physique : Iteration No ',true_itau
    666676c$OMP END MASTER
    667677
    … …  
    669679
    670680c$OMP BARRIER
    671 
    672681         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    673682c$OMP BARRIER
    … …  
    683692c   -----------------------------------------------------
    684693
    685 #ifdef CPP_PHYS
    686694c+jld
    687695
    … …  
    689697      IF (ip_ebil_dyn.ge.1 ) THEN
    690698          ztit='bil dyn'
    691           CALL diagedyn(ztit,2,1,1,dtphys
    692      e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     699! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
     700           IF (planet_type.eq."earth") THEN
     701            CALL diagedyn(ztit,2,1,1,dtphys
     702     &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     703           ENDIF
    693704      ENDIF
    694705c-jld
    … …  
    725736       
    726737c        call SetDistrib(jj_nb_vanleer)
    727         do j=1,nqmx
     738        do j=1,nqtot
    728739 
    729740          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    756767cc$OMP BARRIER
    757768!        CALL FTRACE_REGION_BEGIN("calfis")
    758         CALL calfis_p( nq, lafin ,rdayvrai,time  ,
     769        CALL calfis_p(lafin ,rdayvrai,time  ,
    759770     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    760771     $               du,dv,dteta,dq,
    … …  
    777788          dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
    778789c$OMP END MASTER
    779         endif
     790        endif ! of if ( .not. pole_nord)
    780791
    781792c$OMP BARRIER
    … …  
    799810     *                      1,0,0,1,Request_physic)
    800811
    801         do j=1,nqmx
     812        do j=1,nqtot
    802813          call Register_Hallo(dqfi(1,1,j),ip1jmp1,llm,
    803814     *                        1,0,0,1,Request_physic)
    … …  
    833844c$OMP END MASTER
    834845         
    835         endif
     846        endif ! of if (.not. pole_nord)
    836847c$OMP BARRIER
    837848cc$OMP MASTER       
    … …  
    842853cc$OMP END MASTER
    843854c     
    844 c      do j=1,nqmx
     855c      do j=1,nqtot
    845856c        call WriteField_p('dqfi'//trim(int2str(j)),
    846857c     .                reshape(dqfi(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    853864         ENDIF
    854865       
    855           CALL addfi_p( nqmx, dtphys, leapf, forward   ,
     866          CALL addfi_p( dtphys, leapf, forward   ,
    856867     $                  ucov, vcov, teta , q   ,ps ,
    857868     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    … …  
    889900     *                               jj_Nb_caldyn,Request_physic)
    890901
    891         do j=1,nqmx
     902        do j=1,nqtot
    892903       
    893904          call Register_SwapField(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    922933cc$OMP END MASTER
    923934
    924 #else
    925 
     935
     936c-jld
     937c$OMP MASTER
     938         call resume_timer(timer_caldyn)
     939         if (FirstPhysic) then
     940           ok_start_timer=.TRUE.
     941           FirstPhysic=.false.
     942         endif
     943c$OMP END MASTER
     944       ENDIF ! of IF( apphys )
     945
     946      IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
    926947c   Calcul academique de la physique = Rappel Newtonien + fritcion
    927948c   --------------------------------------------------------------
    … …  
    939960
    940961       call friction_p(ucov,vcov,iphysiq*dtvr)
    941 
    942 #endif
    943 
    944 c-jld
    945 c$OMP MASTER
    946          call resume_timer(timer_caldyn)
    947          if (FirstPhysic) then
    948            ok_start_timer=.TRUE.
    949            FirstPhysic=.false.
    950          endif
    951 c$OMP END MASTER
    952        ENDIF
     962      ENDIF ! of IF(iflag_phys.EQ.2)
     963
    953964
    954965        CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
    955966c$OMP BARRIER
    956 
    957 
    958967        CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    959968c$OMP BARRIER
    … …  
    12851294               ENDIF
    12861295#ifdef CPP_IOIPSL
     1296             IF (ok_dynzon) THEN
    12871297             call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    12881298             call SendRequest(TestRequest)
    … …  
    12911301c$OMP BARRIER
    12921302c$OMP MASTER
    1293               CALL writedynav_p(histaveid, nqmx, itau,vcov ,
     1303              CALL writedynav_p(histaveid, itau,vcov ,
    12941304     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1295 c$OMP END MASTER
    1296 
     1305
     1306c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP
     1307              CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1308     ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1309c$OMP END MASTER
     1310              ENDIF !ok_dynzon
    12971311#endif
    12981312            ENDIF
    … …  
    13041318c      IF( MOD(itau,iecri         ).EQ.0) THEN
    13051319
    1306            IF( MOD(itau,iecri*day_step).EQ.0) THEN
    1307 c$OMP BARRIER
    1308 c$OMP MASTER
    1309                nbetat = nbetatdem
    1310         CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi )
     1320            IF( MOD(itau,iecri*day_step).EQ.0) THEN
     1321c$OMP BARRIER
     1322c$OMP MASTER
     1323              nbetat = nbetatdem
     1324              CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    13111325       
    13121326cym        unat=0.
    13131327       
    1314         ijb=ij_begin
    1315         ije=ij_end
    1316        
    1317         if (pole_nord) then
    1318           ijb=ij_begin+iip1
    1319           unat(1:iip1,:)=0.
    1320         endif
    1321        
    1322         if (pole_sud) then
    1323           ije=ij_end-iip1
    1324           unat(ij_end-iip1+1:ij_end,:)=0.
    1325         endif
     1328              ijb=ij_begin
     1329              ije=ij_end
     1330       
     1331              if (pole_nord) then
     1332                ijb=ij_begin+iip1
     1333                unat(1:iip1,:)=0.
     1334              endif
     1335       
     1336              if (pole_sud) then
     1337                ije=ij_end-iip1
     1338                unat(ij_end-iip1+1:ij_end,:)=0.
     1339              endif
    13261340           
    1327         do l=1,llm
    1328            unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
    1329         enddo
    1330 
    1331         ijb=ij_begin
    1332         ije=ij_end
    1333         if (pole_sud) ije=ij_end-iip1
    1334        
    1335         do l=1,llm
    1336            vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
    1337         enddo
     1341              do l=1,llm
     1342                unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
     1343              enddo
     1344
     1345              ijb=ij_begin
     1346              ije=ij_end
     1347              if (pole_sud) ije=ij_end-iip1
     1348       
     1349              do l=1,llm
     1350                vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
     1351              enddo
    13381352       
    13391353#ifdef CPP_IOIPSL
    13401354 
    1341         CALL writehist_p(histid,histvid, nqmx,itau,vcov,
    1342      s                       ucov,teta,phi,q,masse,ps,phis)
     1355              CALL writehist_p(histid,histvid, itau,vcov,
     1356     &                         ucov,teta,phi,q,masse,ps,phis)
    13431357
    13441358#endif
    1345 c$OMP END MASTER
    1346            ENDIF
     1359! For some Grads outputs of fields
     1360              if (output_grads_dyn) then
     1361! Ehouarn: hope this works the way I think it does:
     1362                  call Gather_Field(unat,ip1jmp1,llm,0)
     1363                  call Gather_Field(vnat,ip1jm,llm,0)
     1364                  call Gather_Field(teta,ip1jmp1,llm,0)
     1365                  call Gather_Field(ps,ip1jmp1,1,0)
     1366                  do iq=1,nqtot
     1367                    call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1368                  enddo
     1369                  if (mpi_rank==0) then
     1370#include "write_grads_dyn.h"
     1371                  endif
     1372              endif ! of if (output_grads_dyn)
     1373c$OMP END MASTER
     1374            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    13471375
    13481376            IF(itau.EQ.itaufin) THEN
    … …  
    13511379c$OMP MASTER
    13521380
    1353 c#ifdef CPP_IOIPSL
    1354 
    1355        CALL dynredem1_p("restart.nc",0.0,
    1356      ,                     vcov,ucov,teta,q,nqmx,masse,ps)
    1357 c#endif
     1381              if (planet_type.eq."earth") then
     1382#ifdef CPP_EARTH
     1383! Write an Earth-format restart file
     1384                CALL dynredem1_p("restart.nc",0.0,
     1385     &                           vcov,ucov,teta,q,masse,ps)
     1386
     1387#endif
     1388              endif ! of if (planet_type.eq."earth")
    13581389
    13591390              CLOSE(99)
    13601391c$OMP END MASTER
    1361             ENDIF
     1392            ENDIF ! of IF (itau.EQ.itaufin)
    13621393
    13631394c-----------------------------------------------------------------------
    … …  
    13901421                 dt  = 2.*dtvr
    13911422                 GO TO 2
    1392             END IF
    1393 
    1394       ELSE
     1423            END IF ! of IF (MOD(itau,iperiod).EQ.0)
     1424                   !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
     1425
     1426
     1427      ELSE ! of IF (.not.purmats)
    13951428
    13961429c       ........................................................
    … …  
    14191452               GO TO 2
    14201453
    1421             ELSE
    1422 
    1423             IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
     1454            ELSE ! of IF(forward)
     1455
     1456              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    14241457               IF(itau.EQ.itaufin) THEN
    14251458                  iav=1
    … …  
    14281461               ENDIF
    14291462#ifdef CPP_IOIPSL
    1430 c$OMP BARRIER
    1431 
    1432               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    1433               call SendRequest(TestRequest)
    1434 c$OMP BARRIER
    1435               call WaitRequest(TestRequest)
    1436 
    1437 c$OMP BARRIER
    1438 c$OMP MASTER
    1439               CALL writedynav_p(histaveid, nqmx, itau,vcov ,
     1463               IF (ok_dynzon) THEN
     1464c$OMP BARRIER
     1465
     1466               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
     1467               call SendRequest(TestRequest)
     1468c$OMP BARRIER
     1469               call WaitRequest(TestRequest)
     1470
     1471c$OMP BARRIER
     1472c$OMP MASTER
     1473               CALL writedynav_p(histaveid, itau,vcov ,
    14401474     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1441                call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav,
     1475               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    14421476     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    14431477c$OMP END MASTER
     1478               END IF !ok_dynzon
    14441479#endif
    1445             ENDIF
     1480              ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
     1481
    14461482
    14471483c               IF(MOD(itau,iecri         ).EQ.0) THEN
    … …  
    14491485c$OMP BARRIER
    14501486c$OMP MASTER
    1451                   nbetat = nbetatdem
    1452        CALL geopot_p( ip1jmp1, teta  , pk , pks,  phis  , phi   )
     1487                nbetat = nbetatdem
     1488                CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    14531489
    14541490cym        unat=0.
    1455         ijb=ij_begin
    1456         ije=ij_end
    1457        
    1458         if (pole_nord) then
    1459           ijb=ij_begin+iip1
    1460           unat(1:iip1,:)=0.
    1461         endif
    1462        
    1463         if (pole_sud) then
    1464           ije=ij_end-iip1
    1465           unat(ij_end-iip1+1:ij_end,:)=0.
    1466         endif
     1491                ijb=ij_begin
     1492                ije=ij_end
     1493       
     1494                if (pole_nord) then
     1495                  ijb=ij_begin+iip1
     1496                  unat(1:iip1,:)=0.
     1497                endif
     1498       
     1499                if (pole_sud) then
     1500                  ije=ij_end-iip1
     1501                  unat(ij_end-iip1+1:ij_end,:)=0.
     1502                endif
    14671503           
    1468         do l=1,llm
    1469            unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
    1470         enddo
    1471 
    1472         ijb=ij_begin
    1473         ije=ij_end
    1474         if (pole_sud) ije=ij_end-iip1
    1475        
    1476         do l=1,llm
    1477            vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
    1478         enddo
     1504                do l=1,llm
     1505                  unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
     1506                enddo
     1507
     1508                ijb=ij_begin
     1509                ije=ij_end
     1510                if (pole_sud) ije=ij_end-iip1
     1511       
     1512                do l=1,llm
     1513                  vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
     1514                enddo
    14791515
    14801516#ifdef CPP_IOIPSL
    14811517
    1482        CALL writehist_p( histid, histvid, nqmx, itau,vcov ,
    1483      ,                           ucov,teta,phi,q,masse,ps,phis)
    1484 c#else
    1485 c      call Gather_Field(unat,ip1jmp1,llm,0)
    1486 c      call Gather_Field(vnat,ip1jm,llm,0)
    1487 c      call Gather_Field(teta,ip1jmp1,llm,0)
    1488 c      call Gather_Field(ps,ip1jmp1,1,0)
    1489 c      do iq=1,nqmx
    1490 c        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
    1491 c      enddo
     1518                CALL writehist_p(histid, histvid, itau,vcov ,
     1519     &                           ucov,teta,phi,q,masse,ps,phis)
     1520#endif
     1521! For some Grads output (but does it work?)
     1522                if (output_grads_dyn) then
     1523                  call Gather_Field(unat,ip1jmp1,llm,0)
     1524                  call Gather_Field(vnat,ip1jm,llm,0)
     1525                  call Gather_Field(teta,ip1jmp1,llm,0)
     1526                  call Gather_Field(ps,ip1jmp1,1,0)
     1527                  do iq=1,nqtot
     1528                    call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1529                  enddo
    14921530c     
    1493 c      if (mpi_rank==0) then
    1494 c#include "write_grads_dyn.h"
    1495 c      endif
     1531                  if (mpi_rank==0) then
     1532#include "write_grads_dyn.h"
     1533                  endif
     1534                endif ! of if (output_grads_dyn)
     1535
     1536c$OMP END MASTER
     1537              ENDIF ! of IF(MOD(itau,iecri*day_step).EQ.0)
     1538
     1539              IF(itau.EQ.itaufin) THEN
     1540                if (planet_type.eq."earth") then
     1541#ifdef CPP_EARTH
     1542c$OMP MASTER
     1543                   CALL dynredem1_p("restart.nc",0.0,
     1544     .                               vcov,ucov,teta,q,masse,ps)
     1545c$OMP END MASTER
    14961546#endif
    1497 
    1498 c$OMP END MASTER
    1499                ENDIF
    1500 
    1501                  IF(itau.EQ.itaufin) THEN
    1502 c$OMP MASTER
    1503                    CALL dynredem1_p("restart.nc",0.0,
    1504      .                               vcov,ucov,teta,q,nqmx,masse,ps)
    1505 c$OMP END MASTER
    1506                  ENDIF
    1507                  forward = .TRUE.
    1508                  GO TO  1
    1509 
    1510             ENDIF
    1511 
    1512       END IF
    1513 c$OMP MASTER
    1514         call finalize_parallel
    1515 c$OMP END MASTER
    1516         RETURN
     1547                endif ! of if (planet_type.eq."earth")
     1548              ENDIF ! of IF(itau.EQ.itaufin)
     1549
     1550              forward = .TRUE.
     1551              GO TO  1
     1552
     1553            ENDIF ! of IF (forward)
     1554
     1555      END IF ! of IF(.not.purmats)
     1556c$OMP MASTER
     1557      call finalize_parallel
     1558c$OMP END MASTER
     1559      RETURN
    15171560      END
Note: See TracChangeset for help on using the changeset viewer.