Ignore:
Timestamp:
Sep 20, 2006, 12:12:39 PM (18 years ago)
Author:
Laurent Fairhead
Message:

Nouvelles versions de la dynamique YM
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/V3_test/libf/dyn3dpar/leapfrog_p.F

    r630 r709  
    1 !
     1! 
    22! $Header$
    33!
    … …  
    7575
    7676#include "academic.h"
     77#include "clesphys.h"
     78
    7779     
    7880      include 'mpif.h'
    … …  
    160162      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
    161163      CHARACTER*15 ztit
    162       INTEGER   ip_ebil_dyn  ! PRINT level for energy conserv. diag.
    163       SAVE      ip_ebil_dyn
    164       DATA      ip_ebil_dyn/0/
     164!      INTEGER   ip_ebil_dyn  ! PRINT level for energy conserv. diag.
     165!      SAVE      ip_ebil_dyn
     166!      DATA      ip_ebil_dyn/0/
    165167c-jld
    166168
    … …  
    198200      INTEGER :: iapptrac = 0
    199201      INTEGER :: AdjustCount = 0
    200      
     202      INTEGER :: var_time
    201203      ItCount=0
    202204     
    … …  
    229231   1  CONTINUE
    230232
    231       call MPI_BARRIER(MPI_COMM_WORLD,ierr)
     233      call MPI_BARRIER(COMM_LMDZ,ierr)
    232234
    233235#ifdef CPP_IOIPSL
    … …  
    295297
    296298      ItCount=ItCount+1
    297       if (MOD(ItCount,10000)==0) then
     299      if (MOD(ItCount,1)==1) then
    298300        debug=.true.
    299301      else
    … …  
    315317      conser = .FALSE.
    316318      apdiss = .FALSE.
    317 
     319c      idissip=1
    318320      IF( purmats ) THEN
    319321         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
    … …  
    469471       call VTe(VThallo)
    470472
     473     
    471474      if (debug) then   
    472              
    473475        call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
    474476        call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
    … …  
    484486c        enddo       
    485487      endif
    486       
     488 
    487489
    488490     
    … …  
    497499     
    498500      call VTb(VTcaldyn)
    499      
     501
     502      var_time=time+iday-day_ini
     503      OMP_CHUNK=5
     504c$OMP PARALLEL DEFAULT(SHARED)
     505cc$OMP+         SHARED(itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
     506cc$OMP+                phi,conser,du,dv,dteta,dp,w, pbaru,pbarv,
     507cc$OMP+                var_time)     
     508
    500509      CALL caldyn_p
    501510     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    502511     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
    503      
     512
     513c$OMP END PARALLEL     
    504514      call VTe(VTcaldyn)
    505515c      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    … …  
    516526
    517527      IF( forward. OR . leapf )  THEN
    518 
     528c$OMP PARALLEL DEFAULT(SHARED)
    519529c
    520530#ifdef INCA_CH4
    … …  
    530540     .             pk,iapptrac)
    531541#endif
     542
     543c$OMP END PARALLEL
     544
    532545c      do j=1,nqmx
    533546c        call WriteField_p('q'//trim(int2str(j)),
    534 c    .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
     547c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    535548c        call WriteField_p('dq'//trim(int2str(j)),
    536549c     .                reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
    537550c      enddo
    538 
    539          IF (offline) THEN
     551       IF (offline) THEN
    540552Cmaf stokage du flux de masse pour traceurs OFF-LINE
    541553
    … …  
    556568 
    557569       call VTb(VTintegre)
     570c      call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/)))
     571c      call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/)))
     572c      call WriteField_p('tetam1',reshape(tetam1,(/iip1,jmp1,llm/)))
     573c      call WriteField_p('psm1',reshape(psm1,(/iip1,jmp1/)))
     574c      call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
     575c      call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
     576c      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
     577c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
     578c$OMP PARALLEL DEFAULT(SHARED)
    558579       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    559580     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    560581     $              finvmaold                                    )
    561582
     583c$OMP END PARALLEL
     584c      call WriteField_p('ucovm1',reshape(ucovm1,(/iip1,jmp1,llm/)))
     585c      call WriteField_p('vcovm1',reshape(vcovm1,(/iip1,jjm,llm/)))
     586c      call WriteField_p('tetam1',reshape(tetam1,(/iip1,jmp1,llm/)))
     587c      call WriteField_p('psm1',reshape(psm1,(/iip1,jmp1/)))
     588c      call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
     589c      call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
     590c      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
     591c      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
     592
     593c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
     594 
    562595       call VTe(VTintegre)
     596
    563597c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
    564598c
    … …  
    579613c     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
    580614c
     615c$OMP PARALLEL DEFAULT(SHARED)
     616c$OMP+         PRIVATE(rdaym_ini,rdayvrai,ijb,ije)
     617
     618c$OMP MASTER
    581619         call suspend_timer(timer_caldyn)
    582620         print*,'Entree dans la physique : Iteration No ',true_itau
     621c$OMP END MASTER
     622
    583623         CALL pression_p (  ip1jmp1, ap, bp, ps,  p      )
    584624         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    … …  
    605645      ENDIF
    606646c-jld
     647c$OMP BARRIER
     648c$OMP MASTER
    607649        call VTb(VThallo)
    608650        call SetTag(Request_physic,800)
    … …  
    650692       
    651693        call VTb(VTphysiq)
     694c$OMP END MASTER
     695c$OMP BARRIER
     696       
    652697        CALL calfis_p( nq, lafin ,rdayvrai,time  ,
    653698     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    … …  
    657702#endif
    658703     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
    659      
    660704        ijb=ij_begin
    661705        ije=ij_end 
    662706        if ( .not. pole_nord) then
    663           dufi_tmp(1:iip1,:)   = dufi(ijb:ijb+iim,:)
    664           dvfi_tmp(1:iip1,:)   = dvfi(ijb:ijb+iim,:) 
    665           dtetafi_tmp(1:iip1,:)= dtetafi(ijb:ijb+iim,:) 
     707c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     708          DO l=1,llm
     709          dufi_tmp(1:iip1,l)   = dufi(ijb:ijb+iim,l)
     710          dvfi_tmp(1:iip1,l)   = dvfi(ijb:ijb+iim,l) 
     711          dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 
     712          dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 
     713          ENDDO
     714c$OMP END DO NOWAIT
     715
     716c$OMP MASTER
    666717          dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
    667           dqfi_tmp(1:iip1,:,:) = dqfi(ijb:ijb+iim,:,:) 
    668         endif
    669        
     718c$OMP END MASTER
     719        endif
     720
     721c$OMP BARRIER
     722c$OMP MASTER
    670723        call SetDistrib(jj_nb_Physic_bis)
    671724
    … …  
    695748 
    696749        call SetDistrib(jj_nb_Physic)
    697        
     750c$OMP END MASTER
     751c$OMP BARRIER   
    698752                ijb=ij_begin
    699753        if (.not. pole_nord) then
    700           dufi(ijb:ijb+iim,:) = dufi(ijb:ijb+iim,:)+dufi_tmp(1:iip1,:)
    701           dvfi(ijb:ijb+iim,:) = dvfi(ijb:ijb+iim,:)+dvfi_tmp(1:iip1,:)
    702           dtetafi(ijb:ijb+iim,:) = dtetafi(ijb:ijb+iim,:)
    703      &                           +dtetafi_tmp(1:iip1,:)
     754       
     755c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     756          DO l=1,llm
     757            dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
     758            dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
     759            dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)
     760     &                              +dtetafi_tmp(1:iip1,l)
     761            dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:)
     762     &                              + dqfi_tmp(1:iip1,l,:)
     763          ENDDO
     764c$OMP END DO NOWAIT
     765
     766c$OMP MASTER
    704767          dpfi(ijb:ijb+iim)   = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
    705           dqfi(ijb:ijb+iim,:,:) = dqfi(ijb:ijb+iim,:,:)
    706      &                           + dqfi_tmp(1:iip1,:,:)
     768c$OMP END MASTER
     769         
    707770        endif
    708        
     771c$OMP BARRIER
     772cc$OMP MASTER   
    709773c      call WriteField_p('dufi',reshape(dufi,(/iip1,jmp1,llm/)))
    710774c      call WriteField_p('dvfi',reshape(dvfi,(/iip1,jjm,llm/)))
    711775c      call WriteField_p('dtetafi',reshape(dtetafi,(/iip1,jmp1,llm/)))
    712776c      call WriteField_p('dpfi',reshape(dpfi,(/iip1,jmp1/)))
     777cc$OMP END MASTER
    713778c     
    714779c      do j=1,nqmx
    … …  
    723788     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    724789
     790c$OMP BARRIER
     791c$OMP MASTER
    725792        call VTe(VTphysiq)
    726793
    … …  
    765832
    766833        call SetDistrib(jj_Nb_caldyn)
     834c$OMP END MASTER
     835c$OMP BARRIER
    767836c
    768837c  Diagnostique de conservation de l'énergie : difference
    … …  
    772841     e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
    773842      ENDIF
    774      
    775       if (debug) then
    776        call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/)))
    777        call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/)))
    778        call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/)))
    779       endif
     843
     844cc$OMP MASTER     
     845c      if (debug) then
     846c       call WriteField_p('ucovfi',reshape(ucov,(/iip1,jmp1,llm/)))
     847c       call WriteField_p('vcovfi',reshape(vcov,(/iip1,jjm,llm/)))
     848c       call WriteField_p('tetafi',reshape(teta,(/iip1,jmp1,llm/)))
     849c      endif
     850cc$OMP END MASTER
     851
    780852#else
    781853
    … …  
    799871
    800872c-jld
     873c$OMP MASTER
    801874         call resume_timer(timer_caldyn)
    802875         if (FirstPhysic) then
    … …  
    804877           FirstPhysic=.false.
    805878         endif
     879c$OMP END MASTER
     880c$OMP END PARALLEL
    806881       ENDIF
    807882
    … …  
    815890
    816891      IF(apdiss) THEN
     892c$OMP  PARALLEL DEFAULT(SHARED)
     893c$OMP+          PRIVATE(ijb,ije,tppn,tpn,tpps,tps)
     894c$OMP MASTER
    817895        call suspend_timer(timer_caldyn)
    818896       
    … …  
    822900
    823901        call VTb(VThallo)
    824 
     902c$OMP END MASTER
     903
     904c$OMP BARRIER
     905c$OMP MASTER
    825906        call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm,
    826907     *                          jj_Nb_dissip,1,1,Request_dissip)
    … …  
    847928       
    848929        call start_timer(timer_dissip)
     930c$OMP END MASTER
     931c$OMP BARRIER
     932
    849933        call covcont_p(llm,ucov,vcov,ucont,vcont)
    850934        call enercin_p(vcov,ucov,vcont,ucont,ecin0)
    … …  
    853937
    854938        CALL dissip_p(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
    855        
     939         
    856940        ijb=ij_begin
    857941        ije=ij_end
    858        
    859         ucov(ijb:ije,1:llm)=ucov(ijb:ije,1:llm)+dudis(ijb:ije,1:llm)
    860        
     942c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     943        DO l=1,llm
     944          ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
     945        ENDDO
     946c$OMP END DO NOWAIT     
    861947        if (pole_sud) ije=ije-iip1
    862         vcov(ijb:ije,1:llm)=vcov(ijb:ije,1:llm)+dvdis(ijb:ije,1:llm)
     948c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     949        DO l=1,llm
     950          vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
     951        ENDDO
     952c$OMP END DO NOWAIT     
     953
    863954c       teta=teta+dtetadis
    864955
    … …  
    868959C       On rajoute la tendance due a la transform. Ec -> E therm. cree
    869960C       lors de la dissipation
     961c$OMP BARRIER
     962c$OMP MASTER
    870963            call suspend_timer(timer_dissip)
    871964            call VTb(VThallo)
    … …  
    877970            call VTe(VThallo)
    878971            call resume_timer(timer_dissip)
    879            
     972c$OMP END MASTER
     973c$OMP BARRIER       
    880974            call covcont_p(llm,ucov,vcov,ucont,vcont)
    881975            call enercin_p(vcov,ucov,vcont,ucont,ecin)
    … …  
    883977            ijb=ij_begin
    884978            ije=ij_end
    885            
     979c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    886980            do l=1,llm
    887981              do ij=ijb,ije
    … …  
    890984              enddo
    891985            enddo
    892            
     986c$OMP END DO NOWAIT         
    893987       endif
    894988
    895989       ijb=ij_begin
    896990       ije=ij_end
    897            
     991c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    898992         do l=1,llm
    899993           do ij=ijb,ije
    … …  
    901995           enddo
    902996         enddo
    903          
     997c$OMP END DO NOWAIT     
    904998c------------------------------------------------------------------------
    905999
    … …  
    9131007         
    9141008        if (pole_nord) then
     1009c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9151010          DO l  =  1, llm
    9161011            DO ij =  1,iim
    … …  
    9231018            ENDDO
    9241019          ENDDO
    925                
     1020c$OMP END DO NOWAIT
     1021
     1022c$OMP MASTER               
    9261023          DO ij =  1,iim
    9271024            tppn(ij)  = aire(  ij    ) * ps (  ij    )
    … …  
    9321029            ps(  ij    ) = tpn
    9331030          ENDDO
     1031c$OMP END MASTER
    9341032        endif
    9351033       
    9361034        if (pole_sud) then
     1035c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9371036          DO l  =  1, llm
    9381037            DO ij =  1,iim
    … …  
    9451044            ENDDO
    9461045          ENDDO
    947                
     1046c$OMP END DO NOWAIT
     1047
     1048c$OMP MASTER               
    9481049          DO ij =  1,iim
    9491050            tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
    … …  
    9541055            ps(ij+ip1jm) = tps
    9551056          ENDDO
     1057c$OMP END MASTER
    9561058        endif
    9571059
     1060
     1061c$OMP BARRIER
     1062c$OMP MASTER
    9581063        call VTe(VTdissipation)
    9591064
    … …  
    9831088        call resume_timer(timer_caldyn)
    9841089        print *,'fin dissipation'
     1090c$OMP END MASTER
     1091c$OMP END PARALLEL
    9851092      END IF
    9861093
    … …  
    10661173
    10671174            IF( itau. EQ. itaufinp1 ) then 
    1068 c$$$       write(79,*) 'ucov',ucov
    1069 c$$$       write(80,*) 'vcov',vcov
    1070 c$$$       write(81,*) 'teta',teta
    1071 c$$$       write(82,*) 'ps',ps
    1072 c$$$       write(83,*) 'q',q
    1073 c$$$       WRITE(85,*) 'q1 = ',q(:,:,1)
    1074 c$$$       WRITE(86,*) 'q3 = ',q(:,:,3)
    1075 
     1175
     1176              call finalize_parallel
    10761177              abort_message = 'Simulation finished'
    1077 
    10781178              call abort_gcm(modname,abort_message,0)
    10791179            ENDIF
    … …  
    11611261
    11621262
    1163 #ifdef CPP_IOIPSL
     1263c#ifdef CPP_IOIPSL
    11641264       CALL dynredem1_p("restart.nc",0.0,
    11651265     ,                     vcov,ucov,teta,q,nqmx,masse,ps)
    1166 #endif
     1266c#endif
    11671267
    11681268              CLOSE(99)
    … …  
    12181318               forward =  .FALSE.
    12191319               IF( itau. EQ. itaufinp1 ) then 
     1320                 call finalize_parallel
    12201321                 abort_message = 'Simulation finished'
    12211322                 call abort_gcm(modname,abort_message,0)
    … …  
    12961397               ENDIF
    12971398
    1298 #ifdef CPP_IOIPSL
     1399c#ifdef CPP_IOIPSL
    12991400                 IF(itau.EQ.itaufin)
    13001401     . CALL dynredem1_p("restart.nc",0.0,
    13011402     .                     vcov,ucov,teta,q,nqmx,masse,ps)
    1302 #endif
     1403c#endif
    13031404
    13041405                 forward = .TRUE.
    … …  
    13091410      END IF
    13101411
    1311       STOP
     1412        call finalize_parallel
     1413        STOP
    13121414      END
Note: See TracChangeset for help on using the changeset viewer.