MODULE tracer_icosa_mod #ifndef NO_TRACER_PARSER USE trac_types_mod_ico #endif INTEGER, PARAMETER :: advect_none = 0 INTEGER, PARAMETER :: advect_vanleer = 1 TYPE t_tracer CHARACTER(LEN=256) :: name="" INTEGER :: advection_scheme CHARACTER(LEN=256) :: advection_scheme_name="" REAL :: default_init_value=0 LOGICAL :: has_default_init_value=.FALSE. LOGICAL :: already_initialized=.FALSE. END TYPE t_tracer TYPE(t_tracer),ALLOCATABLE,SAVE :: tracers(:) INTERFACE set_advection_scheme MODULE PROCEDURE set_advection_scheme_1, set_advection_scheme_full END INTERFACE #ifdef NO_TRACER_PARSER TYPE trac_type END type trac_type #endif TYPE(trac_type), ALLOCATABLE, SAVE :: tracs(:) CONTAINS SUBROUTINE init_tracer USE grid_param #ifndef NO_TRACER_PARSER USE readTracFiles_mod_ico USE strings_mod_ico #endif USE getin_mod, ONLY : getin IMPLICIT NONE INTEGER :: ftype INTEGER :: iq LOGICAL :: ret CHARACTER(LEN=256) :: scheme REAL :: default_init_value CHARACTER(LEN=10) :: str_iq INTEGER :: unknown_tracer LOGICAL :: is_exist INTEGER :: nb_tracs, nt CHARACTER(LEN=256), SAVE :: type_trac !--- Keyword for tracers type(s) !$OMP THREADPRIVATE(type_trac) CHARACTER(LEN=256), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version !$OMP THREADPRIVATE(types_trac) !$OMP BARRIER !$OMP MASTER ALLOCATE(tracers(nqtot)) nb_tracs=0 #ifndef NO_TRACER_PARSER type_trac="dynamico" CALL getin("type_trac",type_trac) IF(strParse(type_trac, '|', types_trac, n=nt)) STOP 'problem to check type_trac' INQUIRE(file="tracer.def", exist=is_exist) IF (is_exist) THEN ret=readTracersFiles(type_trac, ftype, tracs) CALL getKey_init(tracs) nb_tracs=SIZE(tracs) ENDIF unknown_tracer=1 DO iq=1,nqtot IF (iq<=nb_tracs) THEN tracers(iq)%name=tracs(iq)%name IF(getKey("scheme",scheme,tracs(iq)%name)) scheme="vanleer" tracers(iq)%advection_scheme_name=scheme SELECT CASE (TRIM(scheme)) CASE ("vanleer") tracers(iq)%advection_scheme=advect_vanleer CASE ("none") tracers(iq)%advection_scheme=advect_none CASE DEFAULT PRINT*,"unknow tracer advection scheme : ", TRIM(scheme), "=> ABORT" STOP END SELECT IF(getKey("default_init_value",default_init_value,tracs(iq)%name)) THEN tracers(iq)%has_default_init_value=.FALSE. ELSE tracers(iq)%default_init_value=default_init_value tracers(iq)%has_default_init_value=.TRUE. ENDIF ELSE WRITE( str_iq, '(I3.3)' ) unknown_tracer tracers(iq)%name="tracer"//TRIM(str_iq) tracers(iq)%advection_scheme=advect_vanleer tracers(iq)%advection_scheme_name="vanleer" tracers(iq)%default_init_value = 0 tracers(iq)%already_initialized = .FALSE. unknown_tracer = unknown_tracer + 1 ENDIF ENDDO #endif CALL dump_tracers !$OMP END MASTER !$OMP BARRIER !$OMP MASTER CALL insert_tracer_output !$OMP END MASTER END SUBROUTINE init_tracer SUBROUTINE insert_tracer_output USE xios_mod USE grid_param IMPLICIT NONE TYPE(xios_fieldgroup) :: fieldgroup_hdl TYPE(xios_field) :: field_hdl INTEGER :: iq CALL xios_get_handle("standard_output_tracers",fieldgroup_hdl) DO iq=1,nqtot CALL xios_add_child(fieldgroup_hdl, field_hdl, "tracer_"//TRIM(tracers(iq)%name)) CALL xios_set_attr(field_hdl, name=TRIM(tracers(iq)%name)) ENDDO CALL xios_get_handle("standard_output_tracers_init",fieldgroup_hdl) DO iq=1,nqtot CALL xios_add_child(fieldgroup_hdl, field_hdl, "tracer_"//TRIM(tracers(iq)%name)//"_init") CALL xios_set_attr(field_hdl, name=TRIM(tracers(iq)%name)//"_init") ENDDO END SUBROUTINE insert_tracer_output SUBROUTINE dump_tracers USE grid_param IMPLICIT NONE INTEGER ::iq DO iq=1,nqtot PRINT*, iq, " name=",tracers(iq)%name," advection_scheme=",TRIM(tracers(iq)%advection_scheme_name), " default_init_value=", tracers(iq)%default_init_value ENDDO END SUBROUTINE dump_tracers SUBROUTINE set_advection_scheme_1(nq,scheme) IMPLICIT NONE INTEGER, INTENT(IN) :: nq INTEGER, INTENT(IN) :: scheme tracers(nq)%advection_scheme=scheme END SUBROUTINE set_advection_scheme_1 SUBROUTINE set_advection_scheme_full(schemes) USE grid_param IMPLICIT NONE INTEGER, INTENT(IN) :: schemes(nqtot) tracers(:)%advection_scheme=schemes(:) END SUBROUTINE set_advection_scheme_full END MODULE tracer_icosa_mod