source: codes/icosagcm/trunk/src/time.f90 @ 203

MODULE time_mod
  use prec
  PRIVATE

  INTEGER,SAVE :: ncid
!$OMP THREADPRIVATE(ncid)  
  INTEGER,SAVE :: time_counter_id
!$OMP THREADPRIVATE(time_counter_id)  
  INTEGER,SAVE :: it
!$OMP THREADPRIVATE(it)  

  REAL(rstd),SAVE :: dt
!$OMP THREADPRIVATE(dt)  
  REAL(rstd),SAVE :: write_period
!$OMP THREADPRIVATE(write_period)  
  INTEGER,SAVE    :: itau_out, itau_adv, itau_dissip, itau_physics, itaumax
!$OMP THREADPRIVATE(itau_out, itau_adv, itau_dissip, itau_physics, itaumax)  
  
  INTEGER,SAVE :: day_step,ndays
!$OMP THREADPRIVATE(day_step,ndays)  
  REAL(rstd),SAVE :: jD_ref,jH_ref
!$OMP THREADPRIVATE(jD_ref,jH_ref)  
  INTEGER,SAVE :: day_ini,day_end,annee_ref,day_ref
!$OMP THREADPRIVATE(day_ini,day_end,annee_ref,day_ref)  
  REAL(rstd),SAVE::start_time
!$OMP THREADPRIVATE(start_time)  
  CHARACTER(LEN=255) :: time_style
!$OMP THREADPRIVATE(time_style)  
  INTEGER,SAVE:: an, mois, jour
!$OMP THREADPRIVATE(an, mois, jour)  
  REAL(rstd),SAVE:: heure
!$OMP THREADPRIVATE(heure)  
  CHARACTER (LEN=10):: calend
!$OMP THREADPRIVATE(calend)  

  PUBLIC create_time_counter_header, update_time_counter, close_time_counter, init_time,  &
         dt, write_period, itau_out, itau_adv, itau_dissip, itau_physics, itaumax, & 
day_step,ndays,jD_ref,jH_ref,day_ini,day_end,annee_ref,day_ref,an, mois, jour,heure, &
            calend,time_style




CONTAINS
  
  SUBROUTINE init_time
  USE earth_const
  USE getin_mod
  USE mpipara
  IMPLICIT NONE
  REAL(rstd) :: run_length


   time_style='dcmip'
   CALL getin('time_style',time_style)

   IF (TRIM(time_style)=='dcmip')  Then
    dt=90.
    CALL getin('dt',dt)

    itaumax=100
    CALL getin('itaumax',itaumax)

    run_length=dt*itaumax
    CALL getin('run_length',run_length)
    itaumax=run_length/dt
    IF (is_mpi_root)  THEN
       PRINT *, 'itaumax=',itaumax
       PRINT *, 'itau_adv=',itau_adv, 'itau_dissip=',itau_dissip, 'itau_physics=',itau_physics
    END IF
    dt=dt/scale_factor

    write_period=0
    CALL getin('write_period',write_period)
    write_period=write_period/scale_factor
    itau_out=FLOOR(.5+write_period/dt)
    IF (is_mpi_root) PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out
    ENDIF 

    itau_adv=1
    CALL getin('itau_adv',itau_adv)

    itau_dissip=1
    CALL getin('itau_dissip',itau_dissip)

    itau_physics=1
    CALL getin('itau_physics',itau_physics)

    
    CALL create_time_counter_header
    
  END SUBROUTINE init_time

  SUBROUTINE create_time_counter_header
  USE netcdf_mod
  USE prec
  USE getin_mod
  USE mpipara
  IMPLICIT NONE
  INTEGER :: status
  INTEGER :: timeid, dtid
  REAL(rstd) :: dt
  CHARACTER(LEN=255) :: time_frequency

  CALL getin("dt",dt)

!$OMP BARRIER
!$OMP MASTER  
    IF (is_mpi_root) THEN 
      status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid)
      status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeid)
      status = NF90_DEF_VAR(ncid,'time_counter',NF90_DOUBLE,(/ timeid /),time_counter_id)
      status = NF90_PUT_ATT(ncid,time_counter_id,"long_name","time")
      status = NF90_PUT_ATT(ncid,time_counter_id,"units","seconds since 2000-01-01 00:00:00")
      status = NF90_PUT_ATT(ncid,time_counter_id,"calendar","noleap")
      status = NF90_DEF_VAR(ncid,'mdt',NF90_DOUBLE,varid=dtid)

      WRITE(time_frequency,*) write_period
      PRINT*,TRIM(time_frequency)
      status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"time_frequency",TRIM(time_frequency)//"s")

      status = NF90_ENDDEF(ncid) 

      status=NF90_PUT_VAR(ncid,dtid, dt)
    ENDIF
    it=0
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE create_time_counter_header
  
  SUBROUTINE update_time_counter(time)
  USE netcdf_mod
  USE mpipara
  USE prec
  IMPLICIT NONE
  REAL(rstd),INTENT(IN) ::time
  INTEGER :: status
  REAL(rstd) ::time_array(1)

!$OMP BARRIER
!$OMP MASTER
    time_array(1)=time
  
    it=it+1
    IF (is_mpi_root) THEN 
      status=NF90_PUT_VAR(ncid,time_counter_id,time_array,start=(/ it /),count=(/ 1 /))
      status=NF90_SYNC(ncid)
    ENDIF
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE update_time_counter    
  
  SUBROUTINE close_time_counter
  USE netcdf_mod
  USE mpipara
  IMPLICIT NONE
    INTEGER :: status
    
!$OMP BARRIER
!$OMP MASTER
     IF (is_mpi_root) status=NF90_CLOSE(ncid)
!$OMP END MASTER
!$OMP BARRIER
    
  END SUBROUTINE  close_time_counter 

END MODULE time_mod