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

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)  

  INTEGER,SAVE :: itau0=0
!$OMP THREADPRIVATE(itau0)  

  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    :: itau_check_conserv
!$OMP THREADPRIVATE(itau_check_conserv)  
  
  INTEGER,SAVE :: day_step,ndays
!$OMP THREADPRIVATE(day_step,ndays)  

  CHARACTER(LEN=255) :: time_style
!$OMP THREADPRIVATE(time_style)  

  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,  &
         itau_check_conserv,  & 
         day_step,ndays,time_style,itau0




CONTAINS
  
  SUBROUTINE init_time
    USE earth_const
    USE getin_mod
    USE mpipara
    IMPLICIT NONE
    REAL(rstd) :: run_length
    
    dt=90.
    CALL getin('dt',dt)
    write_period=0
    CALL getin('write_period',write_period)
    itaumax=100
    CALL getin('itaumax',itaumax)    
    run_length=dt*itaumax
    CALL getin('run_length',run_length)
    itaumax=INT(run_length/dt)
    
    time_style='dcmip'
    CALL getin('time_style',time_style)
    SELECT CASE(TRIM(time_style))
    CASE('none') ! do nothing
    CASE('dcmip') ! rescale time step for small-planet experiments
       dt=dt/scale_factor       
       write_period=write_period/scale_factor
       IF (is_mpi_root) PRINT *, 'Output frequency (scaled) set to ',write_period
    CASE DEFAULT
       IF (is_mpi_root) PRINT*,"Bad selector for variable time_style >",TRIM(time_style),"> options are <none>, <dcmip>"
       STOP
    END SELECT
    
    itau_out=FLOOR(.5+write_period/dt)
    IF (is_mpi_root) PRINT *, 'Output frequency itau_out = ',itau_out

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

    itau_dissip=0 ! set to zero which implies itau_dissip will be automatically computed (see init_dissip)
    CALL getin('itau_dissip',itau_dissip)

    itau_physics=1
    CALL getin('itau_physics',itau_physics)
    if (itau_physics<=0) itau_physics = HUGE(itau_physics)

    itau_check_conserv=HUGE(itau_check_conserv)
    CALL getin('itau_check_conserv',itau_check_conserv)

    IF (is_mpi_root)  THEN
       PRINT *, 'itaumax=',itaumax
       PRINT *, 'itau_adv=',itau_adv, 'itau_dissip=',itau_dissip, 'itau_physics=',itau_physics
    END IF
    
    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

  IF (no_io) RETURN
  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)

  IF (no_io) RETURN

!$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

    IF (no_io) RETURN
    
!$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