source: codes/icosagcm/trunk/src/timeloop_gcm.f90 @ 198

MODULE timeloop_gcm_mod
  USE transfert_mod
  USE icosa
  PRIVATE
  
  PUBLIC :: init_timeloop, timeloop

  INTEGER, PARAMETER :: euler=1, rk4=2, mlf=3
  INTEGER, PARAMETER :: itau_sync=10

  TYPE(t_message),SAVE :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0

  TYPE(t_field),POINTER,SAVE :: f_q(:)
  TYPE(t_field),POINTER,SAVE :: f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:)
  TYPE(t_field),POINTER,SAVE :: f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:)
  TYPE(t_field),POINTER,SAVE :: f_u(:),f_um1(:),f_um2(:), f_du(:)
  TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:)
  TYPE(t_field),POINTER,SAVE :: f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:)  

  INTEGER,SAVE :: nb_stage, matsuno_period, scheme    
!$OMP THREADPRIVATE(nb_stage, matsuno_period, scheme)

  REAL(rstd),SAVE :: jD_cur, jH_cur
!$OMP THREADPRIVATE(jD_cur, jH_cur)  
  REAL(rstd),SAVE :: start_time
!$OMP THREADPRIVATE(start_time)
CONTAINS
  
  SUBROUTINE init_timeloop
  USE icosa
  USE dissip_gcm_mod
  USE caldyn_mod
  USE etat0_mod
  USE disvert_mod
  USE guided_mod
  USE advect_tracer_mod
  USE physics_mod
  USE mpipara
  USE omp_para
  USE trace
  USE transfert_mod
  USE check_conserve_mod
  USE output_field_mod
  USE write_field
  IMPLICIT NONE

    CHARACTER(len=255) :: def

!----------------------------------------------------
!  IF (TRIM(time_style)=='lmd')  Then

!   day_step=180
!   CALL getin('day_step',day_step)

!   ndays=1
!   CALL getin('ndays',ndays)

!   dt = daysec/REAL(day_step)
!   itaumax = ndays*day_step

!   calend = 'earth_360d'
!   CALL getin('calend', calend)

!   day_ini = 0
!   CALL getin('day_ini',day_ini)

!   day_end = 0
!   CALL getin('day_end',day_end)

!   annee_ref = 1998
!   CALL getin('annee_ref',annee_ref)

!   start_time = 0
!   CALL getin('start_time',start_time) 

!   
!   write_period=0
!   CALL getin('write_period',write_period)
!      
!   write_period=write_period/scale_factor
!   itau_out=FLOOR(write_period/dt)
!   
!   PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out 

!  mois = 1 ; heure = 0.
!  call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
!  jH_ref = jD_ref - int(jD_ref) 
!  jD_ref = int(jD_ref) 
!  
!  CALL ioconf_startdate(INT(jD_ref),jH_ref) 
!  write(*,*)'annee_ref, mois, day_ref, heure, jD_ref'
!  write(*,*)annee_ref, mois, day_ref, heure, jD_ref
!  write(*,*)"ndays,day_step,itaumax,dt======>"
!  write(*,*)ndays,day_step,itaumax,dt
!  call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
!  write(*,*)'jD_ref+jH_ref,an, mois, jour, heure'
!  write(*,*)jD_ref+jH_ref,an, mois, jour, heure
!  day_end = day_ini + ndays 
! END IF 
!----------------------------------------------------

   IF (xios_output) itau_out=1
   IF (.NOT. enable_io) itau_out=HUGE(itau_out)

! Time-independant orography
    CALL allocate_field(f_phis,field_t,type_real,name='phis')
! Trends
    CALL allocate_field(f_du,field_u,type_real,llm,name='du')
    CALL allocate_field(f_dtheta_rhodz,field_t,type_real,llm,name='dtheta_rhodz')
! Model state at current time step (RK/MLF/Euler)
    CALL allocate_field(f_ps,field_t,type_real, name='ps')
    CALL allocate_field(f_mass,field_t,type_real,llm,name='mass')
    CALL allocate_field(f_u,field_u,type_real,llm,name='u')
    CALL allocate_field(f_theta_rhodz,field_t,type_real,llm,name='theta_rhodz')
! Model state at previous time step (RK/MLF)
    CALL allocate_field(f_um1,field_u,type_real,llm,name='um1')
    CALL allocate_field(f_theta_rhodzm1,field_t,type_real,llm,name='theta_rhodzm1')
! Tracers
    CALL allocate_field(f_q,field_t,type_real,llm,nqtot)
    CALL allocate_field(f_rhodz,field_t,type_real,llm,name='rhodz')
! Mass fluxes
    CALL allocate_field(f_hflux,field_u,type_real,llm)    ! instantaneous mass fluxes
    CALL allocate_field(f_hfluxt,field_u,type_real,llm)   ! mass "fluxes" accumulated in time
    CALL allocate_field(f_wflux,field_t,type_real,llm+1)  ! vertical mass fluxes
    CALL allocate_field(f_dmass,field_t,type_real,llm, name='dmass')

    IF(caldyn_eta == eta_mass) THEN ! eta = mass coordinate (default)
       CALL allocate_field(f_dps,field_t,type_real,name='dps')
       CALL allocate_field(f_psm1,field_t,type_real,name='psm1')
       CALL allocate_field(f_wfluxt,field_t,type_real,llm+1,name='wfluxt')
       ! the following are unused but must point to something
!       f_massm1 => f_mass
    ELSE ! eta = Lagrangian vertical coordinate
       CALL allocate_field(f_massm1,field_t,type_real,llm, name='massm1')
       ! the following are unused but must point to something
       f_wfluxt => f_wflux
       f_dps  => f_phis
       f_psm1 => f_phis
    END IF

    def='runge_kutta'
    CALL getin('scheme',def)

    SELECT CASE (TRIM(def))
      CASE('euler')
        scheme=euler
        nb_stage=1
      CASE ('runge_kutta')
        scheme=rk4
        nb_stage=4
      CASE ('leapfrog_matsuno')
        scheme=mlf
        matsuno_period=5
        CALL getin('matsuno_period',matsuno_period)
        nb_stage=matsuno_period+1
     ! Model state 2 time steps ago (MLF)
        CALL allocate_field(f_theta_rhodzm2,field_t,type_real,llm)
        CALL allocate_field(f_um2,field_u,type_real,llm)
        IF(caldyn_eta == eta_mass) THEN ! eta = mass coordinate (default)
           CALL allocate_field(f_psm2,field_t,type_real)
           ! the following are unused but must point to something
           f_massm2 => f_mass
        ELSE ! eta = Lagrangian vertical coordinate
           CALL allocate_field(f_massm2,field_t,type_real,llm)
           ! the following are unused but must point to something
           f_psm2 => f_phis
        END IF

    CASE default
       PRINT*,'Bad selector for variable scheme : <', TRIM(def),             &
            ' > options are <euler>, <runge_kutta>, <leapfrog_matsuno>'
       STOP
    END SELECT


    CALL init_dissip
    CALL init_caldyn
    CALL init_guided
    CALL init_advect_tracer
    CALL init_check_conserve
    CALL init_physics

    CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)

    CALL transfert_request(f_phis,req_i0) 
    CALL transfert_request(f_phis,req_i1) 
    CALL writefield("phis",f_phis,once=.TRUE.)

    CALL init_message(f_ps,req_i0,req_ps0)
    CALL init_message(f_mass,req_i0,req_mass0)
    CALL init_message(f_theta_rhodz,req_i0,req_theta_rhodz0)
    CALL init_message(f_u,req_e0_vect,req_u0)
    CALL init_message(f_q,req_i0,req_q0)

  END SUBROUTINE init_timeloop
  
  SUBROUTINE timeloop
  USE icosa
  USE dissip_gcm_mod
  USE disvert_mod
  USE caldyn_mod
  USE caldyn_gcm_mod, ONLY : req_ps, req_mass
  USE etat0_mod
  USE guided_mod
  USE advect_tracer_mod
  USE physics_mod
  USE mpipara
  USE omp_para
  USE trace
  USE transfert_mod
  USE check_conserve_mod
  USE xios_mod
  USE output_field_mod
  IMPLICIT NONE  
    REAL(rstd),POINTER :: q(:,:,:)
    REAL(rstd),POINTER :: phis(:), ps(:) ,psm1(:), psm2(:), dps(:)
    REAL(rstd),POINTER :: u(:,:) , um1(:,:), um2(:,:), du(:,:)
    REAL(rstd),POINTER :: rhodz(:,:), mass(:,:), massm1(:,:), massm2(:,:), dmass(:,:)
    REAL(rstd),POINTER :: theta_rhodz(:,:) , theta_rhodzm1(:,:), theta_rhodzm2(:,:), dtheta_rhodz(:,:)
    REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:)

    INTEGER :: ind
    INTEGER :: it,i,j,n,  stage
    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time
    LOGICAL, PARAMETER :: check=.FALSE.
    INTEGER :: start_clock
    INTEGER :: stop_clock
    INTEGER :: rate_clock
    
    CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces

!!$OMP BARRIER
  DO ind=1,ndomain
     CALL swap_dimensions(ind)
     CALL swap_geometry(ind)
     rhodz=f_rhodz(ind); mass=f_mass(ind); ps=f_ps(ind)
     IF(caldyn_eta==eta_mass) THEN
        CALL compute_rhodz(.TRUE., ps, rhodz) ! save rhodz for transport scheme before dynamics update ps
     ELSE
        rhodz(:,:)=mass(:,:)
     END IF
  END DO
  fluxt_zero=.TRUE.

!$OMP MASTER
  CALL SYSTEM_CLOCK(start_clock)
!$OMP END MASTER   

  CALL trace_on
  
  DO it=0,itaumax
    
    CALL xios_update_calendar(it)
    IF (MOD(it,itau_sync)==0) THEN
      CALL send_message(f_ps,req_ps0)
      CALL wait_message(req_ps0)
      CALL send_message(f_mass,req_mass0)
      CALL wait_message(req_mass0)
      CALL send_message(f_theta_rhodz,req_theta_rhodz0) 
      CALL wait_message(req_theta_rhodz0) 
      CALL send_message(f_u,req_u0)
      CALL wait_message(req_u0)
      CALL send_message(f_q,req_q0) 
      CALL wait_message(req_q0) 

!      CALL wait_message(req_ps0)
!      CALL wait_message(req_mass0)
!      CALL wait_message(req_theta_rhodz0) 
!      CALL wait_message(req_u0)
!      CALL wait_message(req_q0) 
    ENDIF

!$OMP MASTER    
    IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It
!$OMP END MASTER    
    IF (mod(it,itau_out)==0 ) THEN
      CALL update_time_counter(dt*it)
      CALL output_field("q",f_q)
      CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)  
    ENDIF
    
    CALL guided(it*dt,f_ps,f_theta_rhodz,f_u,f_q)

    DO stage=1,nb_stage
       CALL caldyn((stage==1) .AND. (MOD(it,itau_out)==0), &
            f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q, &
            f_hflux, f_wflux, f_dps, f_dmass, f_dtheta_rhodz, f_du)
       SELECT CASE (scheme)
       CASE(euler)
          CALL euler_scheme(.TRUE.)
       CASE (rk4)
          CALL rk_scheme(stage)
       CASE (mlf)
          CALL  leapfrog_matsuno_scheme(stage)
       CASE DEFAULT
          STOP
       END SELECT
    END DO

    IF (MOD(it+1,itau_dissip)==0) THEN
!         CALL send_message(f_ps,req_ps)
!         CALL wait_message(req_ps)  
       
       IF(caldyn_eta==eta_mass) THEN
          DO ind=1,ndomain
             IF (.NOT. assigned_domain(ind)) CYCLE
             CALL swap_dimensions(ind)
             CALL swap_geometry(ind)
             mass=f_mass(ind); ps=f_ps(ind);
             CALL compute_rhodz(.TRUE., ps, mass)
          END DO
       ENDIF
!       CALL send_message(f_mass,req_mass)
!       CALL wait_message(req_mass)  
       CALL dissip(f_u,f_du,f_mass,f_phis, f_theta_rhodz,f_dtheta_rhodz)
!       CALL send_message(f_mass,req_mass)
!       CALL wait_message(req_mass)  
       CALL euler_scheme(.FALSE.)  ! update only u, theta
    END IF

    IF(MOD(it+1,itau_adv)==0) THEN

       CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step
       fluxt_zero=.TRUE.

       ! FIXME : check that rhodz is consistent with ps
       IF (check) THEN
         DO ind=1,ndomain
            IF (.NOT. assigned_domain(ind)) CYCLE
            CALL swap_dimensions(ind)
            CALL swap_geometry(ind)
            rhodz=f_rhodz(ind); ps=f_ps(ind);
            CALL compute_rhodz(.FALSE., ps, rhodz)   
         END DO
       ENDIF

    END IF



!----------------------------------------------------
!    jD_cur = jD_ref + day_ini - day_ref + it/day_step
!    jH_cur = jH_ref + start_time + mod(it,day_step)/float(day_step)
!    jD_cur = jD_cur + int(jH_cur)
!    jH_cur = jH_cur - int(jH_cur)
    CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q)

    ENDDO

    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)  

!$OMP MASTER
    CALL SYSTEM_CLOCK(stop_clock)
    CALL SYSTEM_CLOCK(count_rate=rate_clock)
    
    IF (mpi_rank==0) THEN 
      PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock
    ENDIF  
!$OMP END MASTER 
 
  CONTAINS

    SUBROUTINE Euler_scheme(with_dps)
    IMPLICIT NONE
    LOGICAL :: with_dps
    INTEGER :: ind
    INTEGER :: i,j,ij,l
    CALL trace_start("Euler_scheme")  

    DO ind=1,ndomain
       IF (.NOT. assigned_domain(ind)) CYCLE
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)

       IF(with_dps) THEN ! update ps/mass
          IF(caldyn_eta==eta_mass) THEN ! update ps
             ps=f_ps(ind) ; dps=f_dps(ind) ;              
             IF (omp_first) THEN
!$SIMD
                DO ij=ij_begin,ij_end
                    ps(ij)=ps(ij)+dt*dps(ij)
                ENDDO
             ENDIF 
          ELSE ! update mass
             mass=f_mass(ind) ; dmass=f_dmass(ind) ;              
             DO l=1,llm
!$SIMD
                DO ij=ij_begin,ij_end
                    mass(ij,l)=mass(ij,l)+dt*dmass(ij,l)
                ENDDO
             END DO
          END IF

          hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
          wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
          CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind))
       END IF ! update ps/mass
       
       u=f_u(ind) ; theta_rhodz=f_theta_rhodz(ind)
       du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)

       DO l=ll_begin,ll_end
!$SIMD
         DO ij=ij_begin,ij_end
             u(ij+u_right,l)=u(ij+u_right,l)+dt*du(ij+u_right,l)
             u(ij+u_lup,l)=u(ij+u_lup,l)+dt*du(ij+u_lup,l)
             u(ij+u_ldown,l)=u(ij+u_ldown,l)+dt*du(ij+u_ldown,l)
             theta_rhodz(ij,l)=theta_rhodz(ij,l)+dt*dtheta_rhodz(ij,l)
         ENDDO
       ENDDO
    ENDDO

    CALL trace_end("Euler_scheme")  

    END SUBROUTINE Euler_scheme

    SUBROUTINE RK_scheme(stage)
      IMPLICIT NONE
      INTEGER :: ind, stage
      REAL(rstd), DIMENSION(4), PARAMETER :: coef = (/ .25, 1./3., .5, 1. /)
      REAL(rstd) :: tau
      INTEGER :: i,j,ij,l
  
      CALL trace_start("RK_scheme")  

      tau = dt*coef(stage)

      ! if mass coordinate, deal with ps first on one core
      IF(caldyn_eta==eta_mass) THEN
         IF (omp_first) THEN

            DO ind=1,ndomain
               IF (.NOT. assigned_domain(ind)) CYCLE
               CALL swap_dimensions(ind)
               CALL swap_geometry(ind)
               ps=f_ps(ind) ; psm1=f_psm1(ind) ; dps=f_dps(ind) 
               
               IF (stage==1) THEN ! first stage : save model state in XXm1
!$SIMD
                 DO ij=ij_begin,ij_end
                   psm1(ij)=ps(ij)
                 ENDDO
               ENDIF
            
               ! updates are of the form x1 := x0 + tau*f(x1)
!$SIMD
               DO ij=ij_begin,ij_end
                   ps(ij)=psm1(ij)+tau*dps(ij)
               ENDDO
            ENDDO
         ENDIF
!         CALL send_message(f_ps,req_ps)
!ym no overlap for now         
!         CALL wait_message(req_ps)  
      
      ELSE ! Lagrangian coordinate, deal with mass
         DO ind=1,ndomain
            IF (.NOT. assigned_domain(ind)) CYCLE
            CALL swap_dimensions(ind)
            CALL swap_geometry(ind)
            mass=f_mass(ind); dmass=f_dmass(ind); massm1=f_massm1(ind)

            IF (stage==1) THEN ! first stage : save model state in XXm1
               DO l=ll_begin,ll_end
!$SIMD
                 DO ij=ij_begin,ij_end
                    massm1(ij,l)=mass(ij,l)
                 ENDDO
               ENDDO
            END IF

            ! updates are of the form x1 := x0 + tau*f(x1)
            DO l=ll_begin,ll_end
!$SIMD
               DO ij=ij_begin,ij_end
                   mass(ij,l)=massm1(ij,l)+tau*dmass(ij,l)
               ENDDO
            ENDDO
         END DO
!         CALL send_message(f_mass,req_mass)
!ym no overlap for now         
!         CALL wait_message(req_mass)  

      END IF

      ! now deal with other prognostic variables
      DO ind=1,ndomain
         IF (.NOT. assigned_domain(ind)) CYCLE
         CALL swap_dimensions(ind)
         CALL swap_geometry(ind)
         u=f_u(ind)      ; du=f_du(ind)      ; um1=f_um1(ind) 
         theta_rhodz=f_theta_rhodz(ind)
         theta_rhodzm1=f_theta_rhodzm1(ind)
         dtheta_rhodz=f_dtheta_rhodz(ind)
         
         IF (stage==1) THEN ! first stage : save model state in XXm1
           DO l=ll_begin,ll_end
!$SIMD
                DO ij=ij_begin,ij_end
                 um1(ij+u_right,l)=u(ij+u_right,l)
                 um1(ij+u_lup,l)=u(ij+u_lup,l)
                 um1(ij+u_ldown,l)=u(ij+u_ldown,l)
                 theta_rhodzm1(ij,l)=theta_rhodz(ij,l)
             ENDDO
           ENDDO
         END IF        

         DO l=ll_begin,ll_end
!$SIMD
           DO ij=ij_begin,ij_end
               u(ij+u_right,l)=um1(ij+u_right,l)+tau*du(ij+u_right,l)
               u(ij+u_lup,l)=um1(ij+u_lup,l)+tau*du(ij+u_lup,l)
               u(ij+u_ldown,l)=um1(ij+u_ldown,l)+tau*du(ij+u_ldown,l)
               theta_rhodz(ij,l)=theta_rhodzm1(ij,l)+tau*dtheta_rhodz(ij,l)
           ENDDO
         ENDDO

         IF(stage==nb_stage) THEN ! accumulate mass fluxes at last stage
            hflux=f_hflux(ind);     hfluxt=f_hfluxt(ind)
            wflux=f_wflux(ind);     wfluxt=f_wfluxt(ind)
            CALL accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, dt,fluxt_zero(ind))
         END IF
      END DO
      
      CALL trace_end("RK_scheme")
      
    END SUBROUTINE RK_scheme

    SUBROUTINE leapfrog_matsuno_scheme(stage)
    IMPLICIT NONE
    INTEGER :: ind, stage
    REAL :: tau

      CALL trace_start("leapfrog_matsuno_scheme")
    
      tau = dt/nb_stage
      DO ind=1,ndomain
        IF (.NOT. assigned_domain(ind)) CYCLE
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)

        ps=f_ps(ind)   ; u=f_u(ind)   ; theta_rhodz=f_theta_rhodz(ind)
        psm1=f_psm1(ind) ; um1=f_um1(ind) ; theta_rhodzm1=f_theta_rhodzm1(ind)
        psm2=f_psm2(ind) ; um2=f_um2(ind) ; theta_rhodzm2=f_theta_rhodzm2(ind)
        dps=f_dps(ind) ; du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind)

        
        IF (stage==1) THEN
          psm1(:)=ps(:) ; um1(:,:)=u(:,:) ; theta_rhodzm1(:,:)=theta_rhodz(:,:)
          ps(:)=psm1(:)+tau*dps(:)
          u(:,:)=um1(:,:)+tau*du(:,:)
          theta_rhodz(:,:)=theta_rhodzm1(:,:)+tau*dtheta_rhodz(:,:)

        ELSE IF (stage==2) THEN

          ps(:)=psm1(:)+tau*dps(:)
          u(:,:)=um1(:,:)+tau*du(:,:)
          theta_rhodz(:,:)=theta_rhodzm1(:,:)+tau*dtheta_rhodz(:,:)

          psm2(:)=psm1(:) ; theta_rhodzm2(:,:)=theta_rhodzm1(:,:) ; um2(:,:)=um1(:,:) 
          psm1(:)=ps(:) ; theta_rhodzm1(:,:)=theta_rhodz(:,:) ; um1(:,:)=u(:,:) 

        ELSE 

          ps(:)=psm2(:)+2*tau*dps(:)
          u(:,:)=um2(:,:)+2*tau*du(:,:)
          theta_rhodz(:,:)=theta_rhodzm2(:,:)+2*tau*dtheta_rhodz(:,:)

          psm2(:)=psm1(:) ; theta_rhodzm2(:,:)=theta_rhodzm1(:,:) ; um2(:,:)=um1(:,:) 
          psm1(:)=ps(:) ; theta_rhodzm1(:,:)=theta_rhodz(:,:) ; um1(:,:)=u(:,:) 

        ENDIF
      
      ENDDO
      CALL trace_end("leapfrog_matsuno_scheme")
      
    END SUBROUTINE leapfrog_matsuno_scheme  
         
  END SUBROUTINE timeloop    

 SUBROUTINE accumulate_fluxes(hflux,wflux, hfluxt,wfluxt, tau,fluxt_zero)
    USE icosa
    USE omp_para
    USE disvert_mod
    IMPLICIT NONE
    REAL(rstd), INTENT(IN)    :: hflux(3*iim*jjm,llm), wflux(iim*jjm,llm+1)
    REAL(rstd), INTENT(INOUT) :: hfluxt(3*iim*jjm,llm), wfluxt(iim*jjm,llm+1)
    REAL(rstd), INTENT(IN) :: tau
    LOGICAL, INTENT(INOUT) :: fluxt_zero
    INTEGER :: l,i,j,ij

    IF(fluxt_zero) THEN

       fluxt_zero=.FALSE.

       DO l=ll_begin,ll_end
!$SIMD
         DO ij=ij_begin_ext,ij_end_ext
             hfluxt(ij+u_right,l) = tau*hflux(ij+u_right,l)
             hfluxt(ij+u_lup,l) = tau*hflux(ij+u_lup,l)
             hfluxt(ij+u_ldown,l) = tau*hflux(ij+u_ldown,l)
         ENDDO
       ENDDO

       IF(caldyn_eta==eta_mass) THEN ! no need for vertical fluxes if eta_lag
          DO l=ll_begin,ll_endp1
!$SIMD
             DO ij=ij_begin,ij_end
                wfluxt(ij,l) = tau*wflux(ij,l)
             ENDDO
          ENDDO
       END IF

    ELSE

       DO l=ll_begin,ll_end
!$SIMD
         DO ij=ij_begin_ext,ij_end_ext
             hfluxt(ij+u_right,l) = hfluxt(ij+u_right,l)+tau*hflux(ij+u_right,l)
             hfluxt(ij+u_lup,l) = hfluxt(ij+u_lup,l)+tau*hflux(ij+u_lup,l)
             hfluxt(ij+u_ldown,l) = hfluxt(ij+u_ldown,l)+tau*hflux(ij+u_ldown,l)
         ENDDO
       ENDDO

       IF(caldyn_eta==eta_mass) THEN ! no need for vertical fluxes if eta_lag
          DO l=ll_begin,ll_endp1
!$SIMD
             DO ij=ij_begin,ij_end
                   wfluxt(ij,l) = wfluxt(ij,l)+tau*wflux(ij,l)
             ENDDO
          ENDDO
       END IF

   END IF

  END SUBROUTINE accumulate_fluxes
  
!  FUNCTION maxval_i(p)
!    USE icosa
!    IMPLICIT NONE
!    REAL(rstd), DIMENSION(iim*jjm) :: p
!    REAL(rstd) :: maxval_i
!    INTEGER :: j, ij
!    
!    maxval_i=p((jj_begin-1)*iim+ii_begin)
!    
!    DO j=jj_begin-1,jj_end+1
!       ij=(j-1)*iim
!       maxval_i = MAX(maxval_i, MAXVAL(p(ij+ii_begin:ij+ii_end)))
!    END DO
!  END FUNCTION maxval_i

!  FUNCTION maxval_ik(p)
!    USE icosa
!    IMPLICIT NONE
!    REAL(rstd) :: p(iim*jjm, llm)
!    REAL(rstd) :: maxval_ik(llm)
!    INTEGER :: l,j, ij
!    
!    DO l=1,llm
!       maxval_ik(l)=p((jj_begin-1)*iim+ii_begin,l)
!       DO j=jj_begin-1,jj_end+1
!          ij=(j-1)*iim
!          maxval_ik(l) = MAX(maxval_ik(l), MAXVAL(p(ij+ii_begin:ij+ii_end,l)))
!       END DO
!    END DO
!  END FUNCTION maxval_ik

END MODULE timeloop_gcm_mod