73character (len=255),
parameter:: subcategory=
"volgrid6d_class"
77 type(griddim_def) :: griddim
78 TYPE(datetime),
pointer :: time(:)
79 TYPE(vol7d_timerange),
pointer :: timerange(:)
80 TYPE(vol7d_level),
pointer :: level(:)
81 TYPE(volgrid6d_var),
pointer :: var(:)
82 TYPE(grid_id),
POINTER :: gaid(:,:,:,:)
83 REAL,
POINTER :: voldati(:,:,:,:,:,:)
84 integer :: time_definition
85 integer :: category = 0
90 MODULE PROCEDURE volgrid6d_init
96 MODULE PROCEDURE volgrid6d_delete, volgrid6dv_delete
102 MODULE PROCEDURE volgrid6d_read_from_file
103 MODULE PROCEDURE import_from_gridinfo, import_from_gridinfovv, &
104 volgrid6d_import_from_file
110 MODULE PROCEDURE volgrid6d_write_on_file
111 MODULE PROCEDURE export_to_gridinfo, export_to_gridinfov, export_to_gridinfovv,&
112 volgrid6d_export_to_file
118 MODULE PROCEDURE volgrid6d_transform_compute, volgrid6d_v7d_transform_compute,&
119 v7d_volgrid6d_transform_compute, v7d_v7d_transform_compute
125 MODULE PROCEDURE volgrid6d_transform, volgrid6dv_transform,&
126 volgrid6d_v7d_transform, volgrid6dv_v7d_transform, v7d_volgrid6d_transform, &
131 MODULE PROCEDURE vg6d_wind_rot
135 MODULE PROCEDURE vg6d_wind_unrot
141 MODULE PROCEDURE display_volgrid6d,display_volgrid6dv
156 MODULE PROCEDURE vg6d_rounding, vg6dv_rounding
162 wind_rot,wind_unrot,vg6d_c2a,
display,volgrid6d_alloc,volgrid6d_alloc_vol, &
163 volgrid_get_vol_2d, volgrid_set_vol_2d, volgrid_get_vol_3d, volgrid_set_vol_3d
173SUBROUTINE volgrid6d_init(this, griddim, time_definition, categoryappend)
174TYPE(volgrid6d) :: this
175TYPE(griddim_def),
OPTIONAL :: griddim
176INTEGER,
INTENT(IN),
OPTIONAL :: time_definition
177CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
179character(len=512) :: a_name
181if (
present(categoryappend))
then
182 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
184 call l4f_launcher(a_name,a_name_append=trim(subcategory))
186this%category=l4f_category_get(a_name)
192call init(this%griddim)
194if (
present(griddim))
then
195 call copy (griddim,this%griddim)
198CALL vol7d_var_features_init()
200if(
present(time_definition))
then
201 this%time_definition = time_definition
203 this%time_definition = 0
206nullify (this%time,this%timerange,this%level,this%var)
207nullify (this%gaid,this%voldati)
209END SUBROUTINE volgrid6d_init
222SUBROUTINE volgrid6d_alloc(this, dim, ntime, nlevel, ntimerange, nvar, ini)
223TYPE(volgrid6d),
INTENT(inout) :: this
224TYPE(grid_dim),
INTENT(in),
OPTIONAL :: dim
225INTEGER,
INTENT(in),
OPTIONAL :: ntime
226INTEGER,
INTENT(in),
OPTIONAL :: nlevel
227INTEGER,
INTENT(in),
OPTIONAL :: ntimerange
228INTEGER,
INTENT(in),
OPTIONAL :: nvar
229LOGICAL,
INTENT(in),
OPTIONAL :: ini
238IF (
PRESENT(ini))
THEN
245if (
present(dim))
call copy (dim,this%griddim%dim)
248IF (
PRESENT(ntime))
THEN
250 IF (
ASSOCIATED(this%time))
DEALLOCATE(this%time)
254 ALLOCATE(this%time(ntime),stat=stallo)
257 CALL raise_fatal_error()
261 this%time(i) = datetime_miss
268IF (
PRESENT(nlevel))
THEN
269 IF (nlevel >= 0)
THEN
270 IF (
ASSOCIATED(this%level))
DEALLOCATE(this%level)
274 ALLOCATE(this%level(nlevel),stat=stallo)
277 CALL raise_fatal_error()
281 CALL init(this%level(i))
286IF (
PRESENT(ntimerange))
THEN
287 IF (ntimerange >= 0)
THEN
288 IF (
ASSOCIATED(this%timerange))
DEALLOCATE(this%timerange)
292 ALLOCATE(this%timerange(ntimerange),stat=stallo)
295 CALL raise_fatal_error()
299 CALL init(this%timerange(i))
304IF (
PRESENT(nvar))
THEN
306 IF (
ASSOCIATED(this%var))
DEALLOCATE(this%var)
310 ALLOCATE(this%var(nvar),stat=stallo)
313 CALL raise_fatal_error()
317 CALL init(this%var(i))
323end SUBROUTINE volgrid6d_alloc
334SUBROUTINE volgrid6d_alloc_vol(this, ini, inivol, decode)
335TYPE(volgrid6d),
INTENT(inout) :: this
336LOGICAL,
INTENT(in),
OPTIONAL :: ini
337LOGICAL,
INTENT(in),
OPTIONAL :: inivol
338LOGICAL,
INTENT(in),
OPTIONAL :: decode
347IF (
PRESENT(inivol))
THEN
353IF (this%griddim%dim%nx > 0 .AND. this%griddim%dim%ny > 0)
THEN
356 IF (.NOT.
ASSOCIATED(this%var))
CALL volgrid6d_alloc(this, nvar=1, ini=ini)
357 IF (.NOT.
ASSOCIATED(this%time))
CALL volgrid6d_alloc(this, ntime=1, ini=ini)
358 IF (.NOT.
ASSOCIATED(this%level))
CALL volgrid6d_alloc(this, nlevel=1, ini=ini)
359 IF (.NOT.
ASSOCIATED(this%timerange))
CALL volgrid6d_alloc(this, ntimerange=1, ini=ini)
361 IF (optio_log(decode))
THEN
362 IF (.NOT.
ASSOCIATED(this%voldati))
THEN
367 ALLOCATE(this%voldati(this%griddim%dim%nx,this%griddim%dim%ny,&
368 SIZE(this%level),
SIZE(this%time), &
369 SIZE(this%timerange),
SIZE(this%var)),stat=stallo)
372 CALL raise_fatal_error()
377 IF (linivol) this%voldati = rmiss
382 IF (.NOT.
ASSOCIATED(this%gaid))
THEN
386 ALLOCATE(this%gaid(
SIZE(this%level),
SIZE(this%time), &
387 SIZE(this%timerange),
SIZE(this%var)),stat=stallo)
390 CALL raise_fatal_error()
404 this%gaid = grid_id_new()
410 &trying to allocate a volume with an invalid or unspecified horizontal grid')
411 CALL raise_fatal_error()
414END SUBROUTINE volgrid6d_alloc_vol
430SUBROUTINE volgrid_get_vol_2d(this, ilevel, itime, itimerange, ivar, voldati)
432INTEGER,
INTENT(in) :: ilevel
433INTEGER,
INTENT(in) :: itime
434INTEGER,
INTENT(in) :: itimerange
435INTEGER,
INTENT(in) :: ivar
436REAL,
POINTER :: voldati(:,:)
438IF (
ASSOCIATED(this%voldati))
THEN
439 voldati => this%voldati(:,:,ilevel,itime,itimerange,ivar)
442 IF (.NOT.
ASSOCIATED(voldati))
THEN
443 ALLOCATE(voldati(this%griddim%dim%nx,this%griddim%dim%ny))
445 CALL grid_id_decode_data(this%gaid(ilevel,itime,itimerange,ivar), voldati)
448END SUBROUTINE volgrid_get_vol_2d
464SUBROUTINE volgrid_get_vol_3d(this, itime, itimerange, ivar, voldati)
466INTEGER,
INTENT(in) :: itime
467INTEGER,
INTENT(in) :: itimerange
468INTEGER,
INTENT(in) :: ivar
469REAL,
POINTER :: voldati(:,:,:)
473IF (
ASSOCIATED(this%voldati))
THEN
474 voldati => this%voldati(:,:,:,itime,itimerange,ivar)
477 IF (.NOT.
ASSOCIATED(voldati))
THEN
478 ALLOCATE(voldati(this%griddim%dim%nx,this%griddim%dim%ny,
SIZE(this%level)))
482 DO ilevel = 1,
SIZE(this%level)
484 CALL grid_id_decode_data(this%gaid(ilevel,itime,itimerange,ivar), &
492END SUBROUTINE volgrid_get_vol_3d
506SUBROUTINE volgrid_set_vol_2d(this, ilevel, itime, itimerange, ivar, voldati)
508INTEGER,
INTENT(in) :: ilevel
509INTEGER,
INTENT(in) :: itime
510INTEGER,
INTENT(in) :: itimerange
511INTEGER,
INTENT(in) :: ivar
512REAL,
INTENT(in) :: voldati(:,:)
514IF (
ASSOCIATED(this%voldati))
THEN
517 CALL grid_id_encode_data(this%gaid(ilevel,itime,itimerange,ivar), voldati)
520END SUBROUTINE volgrid_set_vol_2d
534SUBROUTINE volgrid_set_vol_3d(this, itime, itimerange, ivar, voldati)
536INTEGER,
INTENT(in) :: itime
537INTEGER,
INTENT(in) :: itimerange
538INTEGER,
INTENT(in) :: ivar
539REAL,
INTENT(in) :: voldati(:,:,:)
543IF (
ASSOCIATED(this%voldati))
THEN
548 DO ilevel = 1,
SIZE(this%level)
550 CALL grid_id_encode_data(this%gaid(ilevel,itime,itimerange,ivar), &
558END SUBROUTINE volgrid_set_vol_3d
564SUBROUTINE volgrid6d_delete(this)
567INTEGER :: i, ii, iii, iiii
573if (
associated(this%gaid))
then
575 DO i=1 ,
SIZE(this%gaid,1)
576 DO ii=1 ,
SIZE(this%gaid,2)
577 DO iii=1 ,
SIZE(this%gaid,3)
578 DO iiii=1 ,
SIZE(this%gaid,4)
579 CALL delete(this%gaid(i,ii,iii,iiii))
584 DEALLOCATE(this%gaid)
595if (
associated( this%time ))
deallocate(this%time)
596if (
associated( this%timerange ))
deallocate(this%timerange)
597if (
associated( this%level ))
deallocate(this%level)
598if (
associated( this%var ))
deallocate(this%var)
600if (
associated(this%voldati))
deallocate(this%voldati)
604call l4f_category_delete(this%category)
606END SUBROUTINE volgrid6d_delete
618subroutine volgrid6d_write_on_file (this,unit,description,filename,filename_auto)
621integer,
optional,
intent(inout) :: unit
622character(len=*),
intent(in),
optional :: filename
623character(len=*),
intent(out),
optional :: filename_auto
624character(len=*),
INTENT(IN),
optional :: description
627character(len=254) :: ldescription,arg,lfilename
628integer :: ntime, ntimerange, nlevel, nvar
630logical :: opened,exist
642call date_and_time(values=tarray)
645if (
present(description))
then
646 ldescription=description
648 ldescription=
"Volgrid6d generated by: "//trim(arg)
651if (.not.
present(unit))
then
662lfilename=trim(arg)//
".vg6d"
663if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
665if (
present(filename))
then
666 if (filename /=
"")
then
671if (
present(filename_auto))filename_auto=lfilename
674inquire(unit=lunit,opened=opened)
675if (.not. opened)
then
676 inquire(file=lfilename,exist=exist)
677 if (exist)
CALL raise_error(
'file exist; cannot open new file')
678 if (.not.exist)
open (unit=lunit,file=lfilename,form=
"UNFORMATTED")
682if (
associated(this%time)) ntime=
size(this%time)
683if (
associated(this%timerange)) ntimerange=
size(this%timerange)
684if (
associated(this%level)) nlevel=
size(this%level)
685if (
associated(this%var)) nvar=
size(this%var)
688write(unit=lunit)ldescription
689write(unit=lunit)tarray
692write(unit=lunit) ntime, ntimerange, nlevel, nvar
695if (
associated(this%time))
call write_unit(this%time, lunit)
696if (
associated(this%level))
write(unit=lunit)this%level
697if (
associated(this%timerange))
write(unit=lunit)this%timerange
698if (
associated(this%var))
write(unit=lunit)this%var
703if (
associated(this%voldati))
write(unit=lunit)this%voldati
705if (.not.
present(unit))
close(unit=lunit)
707end subroutine volgrid6d_write_on_file
716subroutine volgrid6d_read_from_file (this,unit,filename,description,tarray,filename_auto)
719integer,
intent(inout),
optional :: unit
720character(len=*),
INTENT(in),
optional :: filename
721character(len=*),
intent(out),
optional :: filename_auto
722character(len=*),
INTENT(out),
optional :: description
723integer,
intent(out),
optional :: tarray(8)
725integer :: ntime, ntimerange, nlevel, nvar
727character(len=254) :: ldescription,lfilename,arg
728integer :: ltarray(8),lunit
729logical :: opened,exist
737if (.not.
present(unit))
then
748lfilename=trim(arg)//
".vg6d"
749if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
751if (
present(filename))
then
752 if (filename /=
"")
then
757if (
present(filename_auto))filename_auto=lfilename
760inquire(unit=lunit,opened=opened)
761if (.not. opened)
then
762 inquire(file=lfilename,exist=exist)
763 IF (.NOT. exist)
CALL raise_fatal_error(
'file '//trim(lfilename)//
' does not exist, cannot open')
764 open (unit=lunit,file=lfilename,form=
"UNFORMATTED")
767read(unit=lunit)ldescription
768read(unit=lunit)ltarray
770call l4f_log(l4f_info,
"Info: reading volgrid6d from file: "//trim(lfilename))
771call l4f_log(l4f_info,
"Info: description: "//trim(ldescription))
774if (
present(description))description=ldescription
775if (
present(tarray))tarray=ltarray
779read(unit=lunit) ntime, ntimerange, nlevel, nvar
782call volgrid6d_alloc (this, &
783 ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nvar=nvar)
785call volgrid6d_alloc_vol (this)
787if (
associated(this%time))
call read_unit(this%time, lunit)
788if (
associated(this%level))
read(unit=lunit)this%level
789if (
associated(this%timerange))
read(unit=lunit)this%timerange
790if (
associated(this%var))
read(unit=lunit)this%var
795if (
associated(this%voldati))
read(unit=lunit)this%voldati
797if (.not.
present(unit))
close(unit=lunit)
799end subroutine volgrid6d_read_from_file
821SUBROUTINE import_from_gridinfo(this, gridinfo, force, dup_mode, clone, &
825LOGICAL,
INTENT(in),
OPTIONAL :: force
826INTEGER,
INTENT(in),
OPTIONAL :: dup_mode
827LOGICAL ,
INTENT(in),
OPTIONAL :: clone
828LOGICAL,
INTENT(IN),
OPTIONAL :: isanavar
830CHARACTER(len=255) :: type
831INTEGER :: itime0, itimerange0, itime1, itimerange1, itime, itimerange, &
832 ilevel, ivar, ldup_mode
836REAL,
ALLOCATABLE :: tmpgrid(:,:)
838IF (
PRESENT(dup_mode))
THEN
844call get_val(this%griddim,proj_type=type)
847call l4f_category_log(this%category,l4f_debug,
"import_from_gridinfo: "//trim(type))
850if (.not.
c_e(type))
then
851 call copy(gridinfo%griddim, this%griddim)
855 CALL volgrid6d_alloc_vol(this, ini=.true.)
857else if (.not. (this%griddim == gridinfo%griddim ))
then
860 "volgrid and gridinfo grid type or size are different, gridinfo rejected")
867ilevel =
index(this%level, gridinfo%level)
868IF (ilevel == 0 .AND. optio_log(force))
THEN
869 ilevel =
index(this%level, vol7d_level_miss)
870 IF (ilevel /= 0) this%level(ilevel) = gridinfo%level
875 "volgrid6d: level not valid for volume, gridinfo rejected")
880IF (optio_log(isanavar))
THEN
882 itime1 =
SIZE(this%time)
884 itimerange1 =
SIZE(this%timerange)
886 correctedtime = gridinfo%time
887 IF (this%time_definition == 1 .OR. this%time_definition == 2) correctedtime = correctedtime + &
888 timedelta_new(sec=gridinfo%timerange%p1)
889 itime0 =
index(this%time, correctedtime)
890 IF (itime0 == 0 .AND. optio_log(force))
THEN
891 itime0 =
index(this%time, datetime_miss)
892 IF (itime0 /= 0) this%time(itime0) = correctedtime
894 IF (itime0 == 0)
THEN
896 "volgrid6d: time not valid for volume, gridinfo rejected")
902 correctedtimerange = gridinfo%timerange
903 IF (this%time_definition == 2) correctedtimerange%p1 = 0
904 itimerange0 =
index(this%timerange, correctedtimerange)
905 IF (itimerange0 == 0 .AND. optio_log(force))
THEN
906 itimerange0 =
index(this%timerange, vol7d_timerange_miss)
907 IF (itimerange0 /= 0) this%timerange(itimerange0) = gridinfo%timerange
909 IF (itimerange0 == 0)
THEN
911 "volgrid6d: timerange not valid for volume, gridinfo rejected")
915 itimerange1 = itimerange0
918ivar =
index(this%var, gridinfo%var)
919IF (ivar == 0 .AND. optio_log(force))
THEN
920 ivar =
index(this%var, volgrid6d_var_miss)
921 IF (ivar /= 0) this%var(ivar) = gridinfo%var
925 "volgrid6d: var not valid for volume, gridinfo rejected")
930DO itimerange = itimerange0, itimerange1
931 DO itime = itime0, itime1
932 IF (
ASSOCIATED(this%gaid))
THEN
934 IF (
c_e(this%gaid(ilevel,itime,itimerange,ivar)))
THEN
938 IF (optio_log(
clone))
CALL delete(this%gaid(ilevel,itime,itimerange,ivar))
941 IF (optio_log(
clone))
THEN
942 CALL copy(gridinfo%gaid, this%gaid(ilevel,itime,itimerange,ivar))
947 this%gaid(ilevel,itime,itimerange,ivar) = gridinfo%gaid
950 IF (
ASSOCIATED(this%voldati))
THEN
951 IF (.NOT.dup .OR. ldup_mode == 0)
THEN
952 this%voldati(:,:,ilevel,itime,itimerange,ivar) =
decode_gridinfo(gridinfo)
953 ELSE IF (ldup_mode == 1)
THEN
956 this%voldati(:,:,ilevel,itime,itimerange,ivar) = tmpgrid(:,:)
958 ELSE IF (ldup_mode == 2)
THEN
959 WHERE(.NOT.
c_e(this%voldati(:,:,ilevel,itime,itimerange,ivar)))
960 this%voldati(:,:,ilevel,itime,itimerange,ivar) =
decode_gridinfo(gridinfo)
967 "gaid not allocated, you probably need to call volgrid6d_alloc_vol first")
975END SUBROUTINE import_from_gridinfo
982SUBROUTINE export_to_gridinfo(this, gridinfo, itime, itimerange, ilevel, ivar, &
983 gaid_template, clone)
990TYPE(
grid_id),
INTENT(in),
OPTIONAL :: gaid_template
991LOGICAL,
INTENT(in),
OPTIONAL :: clone
994LOGICAL :: usetemplate
995REAL,
POINTER :: voldati(:,:)
1002IF (.NOT.
c_e(this%gaid(ilevel,itime,itimerange,ivar)))
THEN
1004 CALL l4f_category_log(this%category,l4f_debug,
"empty gaid found, skipping export")
1009usetemplate = .false.
1010IF (
PRESENT(gaid_template))
THEN
1011 CALL copy(gaid_template, gaid)
1013 CALL l4f_category_log(this%category,l4f_debug,
"template cloned to a new gaid")
1015 usetemplate =
c_e(gaid)
1018IF (.NOT.usetemplate)
THEN
1019 IF (optio_log(
clone))
THEN
1020 CALL copy(this%gaid(ilevel,itime,itimerange,ivar), gaid)
1022 CALL l4f_category_log(this%category,l4f_debug,
"original gaid cloned to a new one")
1025 gaid = this%gaid(ilevel,itime,itimerange,ivar)
1029IF (this%time_definition == 1 .OR. this%time_definition == 2)
THEN
1030 correctedtime = this%time(itime) - &
1031 timedelta_new(sec=this%timerange(itimerange)%p1)
1033 correctedtime = this%time(itime)
1036CALL init(gridinfo,gaid, this%griddim, correctedtime, this%timerange(itimerange), &
1037 this%level(ilevel), this%var(ivar))
1040CALL export(gridinfo%griddim, gridinfo%gaid)
1042IF (
ASSOCIATED(this%voldati))
THEN
1043 CALL encode_gridinfo(gridinfo, this%voldati(:,:,ilevel,itime,itimerange,ivar))
1044ELSE IF (usetemplate)
THEN
1046 CALL volgrid_get_vol_2d(this, ilevel, itime, itimerange, ivar, voldati)
1051END SUBROUTINE export_to_gridinfo
1071SUBROUTINE import_from_gridinfovv(this, gridinfov, dup_mode, clone, decode, &
1072 time_definition, anavar, categoryappend)
1075INTEGER,
INTENT(in),
OPTIONAL :: dup_mode
1076LOGICAL ,
INTENT(in),
OPTIONAL :: clone
1077LOGICAL,
INTENT(in),
OPTIONAL :: decode
1078INTEGER,
INTENT(IN),
OPTIONAL :: time_definition
1079CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: anavar(:)
1080CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
1082INTEGER :: i, j, stallo
1083INTEGER :: ngrid, ntime, ntimerange, nlevel, nvar, ltime_definition
1085CHARACTER(len=512) :: a_name
1086TYPE(
datetime),
ALLOCATABLE :: correctedtime(:)
1087LOGICAL,
ALLOCATABLE :: isanavar(:)
1088TYPE(vol7d_var) :: lvar
1092if (
present(categoryappend))
then
1093 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
1095 call l4f_launcher(a_name,a_name_append=trim(subcategory))
1097category=l4f_category_get(a_name)
1103IF (
PRESENT(time_definition))
THEN
1104 ltime_definition = max(min(time_definition, 2), 0)
1106 ltime_definition = 0
1109ngrid=count_distinct(gridinfov%array(1:gridinfov%arraysize)%griddim,back=.true.)
1111 ' different grid definition(s) found in input data')
1113ALLOCATE(this(ngrid),stat=stallo)
1116 CALL raise_fatal_error()
1119 IF (
PRESENT(categoryappend))
THEN
1120 CALL init(this(i), time_definition=ltime_definition, categoryappend=trim(categoryappend)//
"-vol"//
t2c(i))
1122 CALL init(this(i), time_definition=ltime_definition, categoryappend=
"vol"//
t2c(i))
1126this(:)%griddim=pack_distinct(gridinfov%array(1:gridinfov%arraysize)%griddim, &
1130ALLOCATE(isanavar(gridinfov%arraysize))
1131isanavar(:) = .false.
1132IF (
PRESENT(anavar))
THEN
1133 DO i = 1, gridinfov%arraysize
1134 DO j = 1,
SIZE(anavar)
1135 lvar =
convert(gridinfov%array(i)%var)
1136 IF (lvar%btable == anavar(j))
THEN
1137 isanavar(i) = .true.
1143 t2c(gridinfov%arraysize)//
' constant-data messages found in input data')
1146IF (ltime_definition == 1 .OR. ltime_definition == 2)
THEN
1147 ALLOCATE(correctedtime(gridinfov%arraysize))
1148 correctedtime(:) = gridinfov%array(1:gridinfov%arraysize)%time
1149 DO i = 1, gridinfov%arraysize
1150 correctedtime(i) = correctedtime(i) + &
1151 timedelta_new(sec=gridinfov%array(i)%timerange%p1)
1154IF (ltime_definition == 2)
THEN
1155 ALLOCATE(correctedtimerange(gridinfov%arraysize))
1156 correctedtimerange(:) = gridinfov%array(1:gridinfov%arraysize)%timerange
1157 correctedtimerange(:)%p1 = 0
1161 IF (
PRESENT(anavar))
THEN
1162 j = count((this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1163 .AND. .NOT.isanavar(:))
1166 ' has only constant data, this is not allowed')
1168 CALL raise_fatal_error()
1171 IF (ltime_definition == 1 .OR. ltime_definition == 2)
THEN
1172 ntime = count_distinct(correctedtime, &
1173 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1174 .AND. .NOT.isanavar(:), back=.true.)
1176 ntime = count_distinct(gridinfov%array(1:gridinfov%arraysize)%time, &
1177 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1178 .AND. .NOT.isanavar(:), back=.true.)
1180 IF (ltime_definition == 2)
THEN
1181 ntimerange = count_distinct(correctedtimerange, &
1182 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1183 .AND. .NOT.isanavar(:), back=.true.)
1185 ntimerange = count_distinct(gridinfov%array(1:gridinfov%arraysize)%timerange, &
1186 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1187 .AND. .NOT.isanavar(:), back=.true.)
1189 nlevel = count_distinct(gridinfov%array(1:gridinfov%arraysize)%level, &
1190 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim), &
1192 nvar = count_distinct(gridinfov%array(1:gridinfov%arraysize)%var, &
1193 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim), &
1200 CALL volgrid6d_alloc(this(i),this(i)%griddim%dim,ntime=ntime, &
1201 ntimerange=ntimerange,nlevel=nlevel,nvar=nvar)
1203 IF (ltime_definition == 1 .OR. ltime_definition == 2)
THEN
1204 this(i)%time = pack_distinct(correctedtime, ntime, &
1205 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1206 .AND. .NOT.isanavar(:), back=.true.)
1208 this(i)%time = pack_distinct(gridinfov%array(1:gridinfov%arraysize)%time, ntime, &
1209 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1210 .AND. .NOT.isanavar(:), back=.true.)
1212 CALL sort(this(i)%time)
1214 IF (ltime_definition == 2)
THEN
1215 this(i)%timerange = pack_distinct(correctedtimerange, ntimerange, &
1216 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1217 .AND. .NOT.isanavar(:), back=.true.)
1219 this(i)%timerange = pack_distinct(gridinfov%array(1:gridinfov%arraysize)%timerange, &
1220 ntimerange, mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim) &
1221 .AND. .NOT.isanavar(:), back=.true.)
1223 CALL sort(this(i)%timerange)
1225 this(i)%level=pack_distinct(gridinfov%array(1:gridinfov%arraysize)%level, &
1226 nlevel,mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim), &
1228 CALL sort(this(i)%level)
1230 this(i)%var=pack_distinct(gridinfov%array(1:gridinfov%arraysize)%var, nvar, &
1231 mask=(this(i)%griddim == gridinfov%array(1:gridinfov%arraysize)%griddim), &
1237 CALL volgrid6d_alloc_vol(this(i), decode=decode)
1241IF (ltime_definition == 1 .OR. ltime_definition == 2)
DEALLOCATE(correctedtime)
1242IF (ltime_definition == 2)
DEALLOCATE(correctedtimerange)
1244DO i = 1, gridinfov%arraysize
1249 "to volgrid6d index: "//
t2c(
index(this%griddim, gridinfov%array(i)%griddim)))
1252 CALL import(this(
index(this%griddim, gridinfov%array(i)%griddim)), &
1253 gridinfov%array(i), dup_mode=dup_mode,
clone=
clone, isanavar=isanavar(i))
1258CALL l4f_category_delete(category)
1260END SUBROUTINE import_from_gridinfovv
1268SUBROUTINE export_to_gridinfov(this, gridinfov, gaid_template, clone)
1271TYPE(
grid_id),
INTENT(in),
OPTIONAL :: gaid_template
1272LOGICAL,
INTENT(in),
OPTIONAL :: clone
1274INTEGER :: i ,itime, itimerange, ilevel, ivar
1275INTEGER :: ntime, ntimerange, nlevel, nvar
1285CALL dealloc(this%griddim%dim)
1288ntime=
size(this%time)
1289ntimerange=
size(this%timerange)
1290nlevel=
size(this%level)
1294 DO itimerange=1,ntimerange
1298 CALL init(gridinfol)
1299 CALL export(this, gridinfol, itime, itimerange, ilevel, ivar, &
1301 IF (
c_e(gridinfol%gaid))
THEN
1302 CALL insert(gridinfov, gridinfol)
1312END SUBROUTINE export_to_gridinfov
1320SUBROUTINE export_to_gridinfovv(this, gridinfov, gaid_template, clone)
1325TYPE(
grid_id),
INTENT(in),
OPTIONAL :: gaid_template
1326LOGICAL,
INTENT(in),
OPTIONAL :: clone
1333 "export_to_gridinfovv grid index: "//
t2c(i))
1338END SUBROUTINE export_to_gridinfovv
1350SUBROUTINE volgrid6d_import_from_file(this, filename, dup_mode, decode, &
1351 time_definition, anavar, categoryappend)
1353CHARACTER(len=*),
INTENT(in) :: filename
1354INTEGER,
INTENT(in),
OPTIONAL :: dup_mode
1355LOGICAL,
INTENT(in),
OPTIONAL :: decode
1356INTEGER,
INTENT(IN),
OPTIONAL :: time_definition
1357CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: anavar(:)
1358character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
1362CHARACTER(len=512) :: a_name
1366IF (
PRESENT(categoryappend))
THEN
1367 CALL l4f_launcher(a_name,a_name_append= &
1368 trim(subcategory)//
"."//trim(categoryappend))
1370 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
1372category=l4f_category_get(a_name)
1374CALL import(gridinfo, filename=filename, categoryappend=categoryappend)
1376IF (gridinfo%arraysize > 0)
THEN
1378 CALL import(this, gridinfo, dup_mode=dup_mode,
clone=.true., decode=decode, &
1379 time_definition=time_definition, anavar=anavar, &
1380 categoryappend=categoryappend)
1386 CALL l4f_category_log(category,l4f_info,
"file does not contain gridded data")
1390CALL l4f_category_delete(category)
1392END SUBROUTINE volgrid6d_import_from_file
1402SUBROUTINE volgrid6d_export_to_file(this, filename, gaid_template, categoryappend)
1404CHARACTER(len=*),
INTENT(in) :: filename
1405TYPE(
grid_id),
INTENT(in),
OPTIONAL :: gaid_template
1406character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
1410CHARACTER(len=512) :: a_name
1412IF (
PRESENT(categoryappend))
THEN
1413 CALL l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
1415 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
1417category=l4f_category_get(a_name)
1423CALL l4f_category_log(category,l4f_info,
"writing volgrid6d to grib file: "//trim(filename))
1426 CALL export(this, gridinfo, gaid_template=gaid_template,
clone=.true.)
1427 IF (gridinfo%arraysize > 0)
THEN
1428 CALL export(gridinfo, filename)
1436CALL l4f_category_delete(category)
1438END SUBROUTINE volgrid6d_export_to_file
1444SUBROUTINE volgrid6dv_delete(this)
1449IF (
ASSOCIATED(this))
THEN
1450 DO i = 1,
SIZE(this)
1453 "delete volgrid6d vector index: "//trim(
to_char(i)))
1460END SUBROUTINE volgrid6dv_delete
1464SUBROUTINE volgrid6d_transform_compute(this, volgrid6d_in, volgrid6d_out, &
1465 lev_out, var_coord_vol, clone)
1467type(
volgrid6d),
INTENT(in) :: volgrid6d_in
1468type(
volgrid6d),
INTENT(inout) :: volgrid6d_out
1469TYPE(
vol7d_level),
INTENT(in),
OPTIONAL :: lev_out(:)
1470INTEGER,
INTENT(in),
OPTIONAL :: var_coord_vol
1471LOGICAL,
INTENT(in),
OPTIONAL :: clone
1473INTEGER :: ntime, ntimerange, inlevel, onlevel, nvar, &
1474 itime, itimerange, ilevel, ivar, levshift, levused, lvar_coord_vol, spos
1475REAL,
POINTER :: voldatiin(:,:,:), voldatiout(:,:,:), coord_3d_in(:,:,:)
1480call l4f_category_log(volgrid6d_in%category,l4f_debug,
"start volgrid6d_transform_compute")
1488lvar_coord_vol = optio_i(var_coord_vol)
1490if (
associated(volgrid6d_in%time))
then
1491 ntime=
size(volgrid6d_in%time)
1492 volgrid6d_out%time=volgrid6d_in%time
1495if (
associated(volgrid6d_in%timerange))
then
1496 ntimerange=
size(volgrid6d_in%timerange)
1497 volgrid6d_out%timerange=volgrid6d_in%timerange
1500IF (
ASSOCIATED(volgrid6d_in%level))
THEN
1501 inlevel=
SIZE(volgrid6d_in%level)
1503IF (
PRESENT(lev_out))
THEN
1504 onlevel=
SIZE(lev_out)
1505 volgrid6d_out%level=lev_out
1506ELSE IF (
ASSOCIATED(volgrid6d_in%level))
THEN
1507 onlevel=
SIZE(volgrid6d_in%level)
1508 volgrid6d_out%level=volgrid6d_in%level
1511if (
associated(volgrid6d_in%var))
then
1512 nvar=
size(volgrid6d_in%var)
1513 volgrid6d_out%var=volgrid6d_in%var
1516IF (.NOT.
ASSOCIATED(volgrid6d_in%voldati))
THEN
1517 ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
1520IF (.NOT.
ASSOCIATED(volgrid6d_out%voldati))
THEN
1521 ALLOCATE(voldatiout(volgrid6d_out%griddim%dim%nx, volgrid6d_out%griddim%dim%ny, &
1525CALL get_val(this, levshift=levshift, levused=levused)
1527IF (
c_e(lvar_coord_vol))
THEN
1528 CALL get_val(this%trans, output_levtype=output_levtype)
1529 IF (output_levtype%level1 == 103 .OR. output_levtype%level1 == 108)
THEN
1530 spos = firsttrue(volgrid6d_in%level(:) == vol7d_level_new(1))
1533 'output level '//
t2c(output_levtype%level1)// &
1534 ' requested, but height/press of surface not provided in volume')
1536 IF (.NOT.
c_e(levshift) .AND. .NOT.
c_e(levused))
THEN
1538 'internal inconsistence, levshift and levused undefined when they should be')
1547 DO itimerange=1,ntimerange
1550 IF (
c_e(levshift) .AND.
c_e(levused))
THEN
1552 volgrid6d_in%gaid(levshift+1:levshift+levused,itime,itimerange,ivar) &
1555 DO ilevel = 1, min(inlevel,onlevel)
1557 IF (
c_e(volgrid6d_in%gaid(ilevel,itime,itimerange,ivar)) .AND. .NOT. &
1558 c_e(volgrid6d_out%gaid(ilevel,itime,itimerange,ivar)))
THEN
1560 IF (optio_log(
clone))
THEN
1561 CALL copy(volgrid6d_in%gaid(ilevel,itime,itimerange,ivar),&
1562 volgrid6d_out%gaid(ilevel,itime,itimerange,ivar))
1565 "cloning gaid, level "//
t2c(ilevel))
1568 volgrid6d_out%gaid(ilevel,itime,itimerange,ivar) = &
1569 volgrid6d_in%gaid(ilevel,itime,itimerange,ivar)
1574 DO ilevel = min(inlevel,onlevel) + 1, onlevel
1575 IF (
c_e(volgrid6d_in%gaid(inlevel,itime,itimerange,ivar)) .AND. .NOT. &
1576 c_e(volgrid6d_out%gaid(ilevel,itime,itimerange,ivar)))
then
1578 CALL copy(volgrid6d_in%gaid(inlevel,itime,itimerange,ivar),&
1579 volgrid6d_out%gaid(ilevel,itime,itimerange,ivar))
1582 "forced cloning gaid, level "//
t2c(inlevel)//
"->"//
t2c(ilevel))
1587 IF (
c_e(lvar_coord_vol))
THEN
1588 NULLIFY(coord_3d_in)
1589 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, lvar_coord_vol, &
1593 coord_3d_in(:,:,levshift+1:levshift+levused) = rmiss
1595 DO ilevel = levshift+1, levshift+levused
1596 WHERE(
c_e(coord_3d_in(:,:,ilevel)) .AND.
c_e(coord_3d_in(:,:,spos)))
1597 coord_3d_in(:,:,ilevel) = coord_3d_in(:,:,ilevel) - &
1598 coord_3d_in(:,:,spos)
1600 coord_3d_in(:,:,ilevel) = rmiss
1606 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, &
1608 IF (
ASSOCIATED(volgrid6d_out%voldati)) &
1609 CALL volgrid_get_vol_3d(volgrid6d_out, itime, itimerange, ivar, &
1611 IF (
c_e(lvar_coord_vol))
THEN
1612 CALL compute(this, voldatiin, voldatiout,
convert(volgrid6d_in%var(ivar)), &
1613 coord_3d_in(:,:,levshift+1:levshift+levused))
1615 CALL compute(this, voldatiin, voldatiout,
convert(volgrid6d_in%var(ivar)))
1617 CALL volgrid_set_vol_3d(volgrid6d_out, itime, itimerange, ivar, &
1623IF (
c_e(lvar_coord_vol))
THEN
1624 DEALLOCATE(coord_3d_in)
1626IF (.NOT.
ASSOCIATED(volgrid6d_in%voldati))
THEN
1627 DEALLOCATE(voldatiin)
1629IF (.NOT.
ASSOCIATED(volgrid6d_out%voldati))
THEN
1630 DEALLOCATE(voldatiout)
1634END SUBROUTINE volgrid6d_transform_compute
1643SUBROUTINE volgrid6d_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1644 lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1647TYPE(
volgrid6d),
INTENT(inout) :: volgrid6d_in
1648TYPE(
volgrid6d),
INTENT(out) :: volgrid6d_out
1649TYPE(
vol7d_level),
INTENT(in),
OPTIONAL,
TARGET :: lev_out(:)
1650TYPE(
volgrid6d),
INTENT(in),
OPTIONAL :: volgrid6d_coord_in
1651REAL,
INTENT(in),
OPTIONAL :: maskgrid(:,:)
1652REAL,
INTENT(in),
OPTIONAL :: maskbounds(:)
1653LOGICAL,
INTENT(in),
OPTIONAL :: clone
1654LOGICAL,
INTENT(in),
OPTIONAL :: decode
1655CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
1660TYPE(vol7d_var) :: vcoord_var
1661INTEGER :: i, k, ntime, ntimerange, nlevel, nvar, var_coord_in, var_coord_vol, &
1662 cf_out, nxc, nyc, nxi, nyi, i3, i4, i5, i6, &
1663 ulstart, ulend, spos
1664REAL,
ALLOCATABLE :: coord_3d_in(:,:,:)
1665TYPE(geo_proj) :: proj_in, proj_out
1666CHARACTER(len=80) :: trans_type
1668LOGICAL,
ALLOCATABLE :: mask_in(:)
1671call l4f_category_log(volgrid6d_in%category, l4f_debug,
"start volgrid6d_transform")
1679if (
associated(volgrid6d_in%time)) ntime=
size(volgrid6d_in%time)
1680if (
associated(volgrid6d_in%timerange)) ntimerange=
size(volgrid6d_in%timerange)
1681if (
associated(volgrid6d_in%level)) nlevel=
size(volgrid6d_in%level)
1682if (
associated(volgrid6d_in%var)) nvar=
size(volgrid6d_in%var)
1684IF (ntime == 0 .OR. ntimerange == 0 .OR. nlevel == 0 .OR. nvar == 0)
THEN
1686 "trying to transform an incomplete volgrid6d object, ntime="//
t2c(ntime)// &
1687 ' ntimerange='//
t2c(ntimerange)//
' nlevel='//
t2c(nlevel)//
' nvar='//
t2c(nvar))
1688 CALL init(volgrid6d_out)
1693CALL get_val(this, trans_type=trans_type)
1697IF (
PRESENT(griddim) .AND. (trans_type ==
'inter' .OR. trans_type ==
'boxinter' &
1698 .OR. trans_type ==
'stencilinter'))
THEN
1700 CALL get_val(griddim, component_flag=cf_out,
proj=proj_out)
1702 IF (proj_in /= proj_out)
CALL vg6d_wind_unrot(volgrid6d_in)
1703ELSE IF (
PRESENT(griddim))
THEN
1704 CALL get_val(griddim, component_flag=cf_out)
1709var_coord_vol = imiss
1710IF (trans_type ==
'vertint')
THEN
1711 IF (
PRESENT(lev_out))
THEN
1714 IF (
PRESENT(volgrid6d_coord_in))
THEN
1715 IF (
ASSOCIATED(volgrid6d_coord_in%voldati))
THEN
1718 IF (
SIZE(volgrid6d_coord_in%voldati,4) /= 1 .OR. &
1719 SIZE(volgrid6d_coord_in%voldati,5) /= 1)
THEN
1721 'volume providing constant input vertical coordinate must have &
1722 &only 1 time and 1 timerange')
1723 CALL init(volgrid6d_out)
1729 CALL get_val(this, output_levtype=output_levtype)
1731 IF (.NOT.
c_e(vcoord_var))
THEN
1733 'requested output level type '//
t2c(output_levtype%level1)// &
1734 ' does not correspond to any known physical variable for &
1735 &providing vertical coordinate')
1736 CALL init(volgrid6d_out)
1741 DO i = 1,
SIZE(volgrid6d_coord_in%var)
1742 IF (
convert(volgrid6d_coord_in%var(i)) == vcoord_var)
THEN
1748 IF (.NOT.
c_e(var_coord_in))
THEN
1750 'volume providing constant input vertical coordinate contains no &
1751 &variables matching output level type '//
t2c(output_levtype%level1))
1752 CALL init(volgrid6d_out)
1757 'Coordinate for vertint found in coord volume at position '// &
1763 CALL get_val(volgrid6d_coord_in%griddim, nx=nxc, ny=nyc)
1764 CALL get_val(volgrid6d_in%griddim, nx=nxi, ny=nyi)
1765 IF (nxc /= nxi .OR. nyc /= nyi)
THEN
1767 'volume providing constant input vertical coordinate must have &
1768 &the same grid as the input')
1770 'vertical coordinate: '//
t2c(nxc)//
'x'//
t2c(nyc)// &
1771 ', input volume: '//
t2c(nxi)//
'x'//
t2c(nyi))
1772 CALL init(volgrid6d_out)
1778 CALL get_val(this, input_levtype=input_levtype)
1780 (volgrid6d_coord_in%level(:)%level1 == input_levtype%level1) .AND. &
1781 (volgrid6d_coord_in%level(:)%level2 == input_levtype%level2)
1782 ulstart = firsttrue(mask_in)
1783 ulend = lasttrue(mask_in)
1784 IF (ulstart == 0 .OR. ulend == 0)
THEN
1786 'coordinate file does not contain levels of type '// &
1787 t2c(input_levtype%level1)//
'/'//
t2c(input_levtype%level2)// &
1788 ' specified for input data')
1789 CALL init(volgrid6d_out)
1794 coord_3d_in = volgrid6d_coord_in%voldati(:,:,ulstart:ulend,1,1,var_coord_in)
1796 IF (output_levtype%level1 == 103 .OR. &
1797 output_levtype%level1 == 108)
THEN
1798 spos = firsttrue(volgrid6d_coord_in%level(:) == vol7d_level_new(1))
1801 'output level '//
t2c(output_levtype%level1)// &
1802 ' requested, but height/press of surface not provided in coordinate file')
1803 CALL init(volgrid6d_out)
1807 DO k = 1,
SIZE(coord_3d_in,3)
1808 WHERE(
c_e(coord_3d_in(:,:,k)) .AND. &
1809 c_e(volgrid6d_coord_in%voldati(:,:,spos,1,1,var_coord_in)))
1810 coord_3d_in(:,:,k) = coord_3d_in(:,:,k) - &
1811 volgrid6d_coord_in%voldati(:,:,spos,1,1,var_coord_in)
1813 coord_3d_in(:,:,k) = rmiss
1821 IF (.NOT.
c_e(var_coord_in))
THEN
1823 CALL get_val(this, output_levtype=output_levtype)
1825 IF (
c_e(vcoord_var))
THEN
1826 DO i = 1,
SIZE(volgrid6d_in%var)
1827 IF (
convert(volgrid6d_in%var(i)) == vcoord_var)
THEN
1833 IF (
c_e(var_coord_vol))
THEN
1835 'Coordinate for vertint found in input volume at position '// &
1842 CALL init(volgrid6d_out, griddim=volgrid6d_in%griddim, &
1843 time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend)
1844 IF (
c_e(var_coord_in))
THEN
1845 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, &
1846 coord_3d_in=coord_3d_in, categoryappend=categoryappend)
1848 CALL init(grid_trans, this, lev_in=volgrid6d_in%level, lev_out=lev_out, &
1849 categoryappend=categoryappend)
1852 CALL get_val(grid_trans, output_level_auto=llev_out)
1853 IF (.NOT.
ASSOCIATED(llev_out)) llev_out => lev_out
1854 nlevel =
SIZE(llev_out)
1857 'volgrid6d_transform: vertint requested but lev_out not provided')
1858 CALL init(volgrid6d_out)
1864 CALL init(volgrid6d_out, griddim=griddim, &
1865 time_definition=volgrid6d_in%time_definition, categoryappend=categoryappend)
1866 CALL init(grid_trans, this, in=volgrid6d_in%griddim, out=volgrid6d_out%griddim, &
1867 maskgrid=maskgrid, maskbounds=maskbounds, categoryappend=categoryappend)
1871IF (
c_e(grid_trans))
THEN
1873 CALL volgrid6d_alloc(volgrid6d_out, ntime=ntime, nlevel=nlevel, &
1874 ntimerange=ntimerange, nvar=nvar)
1876 IF (
PRESENT(decode))
THEN
1879 ldecode =
ASSOCIATED(volgrid6d_in%voldati)
1882 decode_loop:
DO i6 = 1,nvar
1883 DO i5 = 1, ntimerange
1886 IF (
c_e(volgrid6d_in%gaid(i3,i4,i5,i6)))
THEN
1887 ldecode = ldecode .OR. grid_id_readonly(volgrid6d_in%gaid(i3,i4,i5,i6))
1895 IF (
PRESENT(decode))
THEN
1896 IF (ldecode.NEQV.decode)
THEN
1898 'volgrid6d_transform: decode status forced to .TRUE. because driver does not allow copy')
1902 CALL volgrid6d_alloc_vol(volgrid6d_out, decode=ldecode)
1907 IF (trans_type ==
'vertint')
THEN
1910 "volgrid6d_transform: vertint to "//
t2c(nlevel)//
" levels")
1912 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out, lev_out=llev_out, &
1915 CALL compute(grid_trans, volgrid6d_in, volgrid6d_out,
clone=
clone)
1918 IF (cf_out == 0)
THEN
1919 CALL wind_unrot(volgrid6d_out)
1920 ELSE IF (cf_out == 1)
THEN
1921 CALL wind_rot(volgrid6d_out)
1927 'volgrid6d_transform: transformation not valid')
1933END SUBROUTINE volgrid6d_transform
1944SUBROUTINE volgrid6dv_transform(this, griddim, volgrid6d_in, volgrid6d_out, &
1945 lev_out, volgrid6d_coord_in, maskgrid, maskbounds, clone, decode, categoryappend)
1948TYPE(
volgrid6d),
INTENT(inout) :: volgrid6d_in(:)
1949TYPE(
volgrid6d),
POINTER :: volgrid6d_out(:)
1950TYPE(
vol7d_level),
INTENT(in),
OPTIONAL :: lev_out(:)
1951TYPE(
volgrid6d),
INTENT(in),
OPTIONAL :: volgrid6d_coord_in
1952REAL,
INTENT(in),
OPTIONAL :: maskgrid(:,:)
1953REAL,
INTENT(in),
OPTIONAL :: maskbounds(:)
1954LOGICAL,
INTENT(in),
OPTIONAL :: clone
1955LOGICAL,
INTENT(in),
OPTIONAL :: decode
1956CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
1961allocate(volgrid6d_out(
size(volgrid6d_in)),stat=stallo)
1963 call l4f_log(l4f_fatal,
"allocating memory")
1964 call raise_fatal_error()
1967do i=1,
size(volgrid6d_in)
1968 call transform(this, griddim, volgrid6d_in(i), volgrid6d_out(i), &
1969 lev_out=lev_out, volgrid6d_coord_in=volgrid6d_coord_in, &
1970 maskgrid=maskgrid, maskbounds=maskbounds, &
1971 clone=
clone, decode=decode, categoryappend=categoryappend)
1974END SUBROUTINE volgrid6dv_transform
1978SUBROUTINE volgrid6d_v7d_transform_compute(this, volgrid6d_in, vol7d_out, &
1979 networkname, noconvert)
1981type(
volgrid6d),
INTENT(in) :: volgrid6d_in
1982type(
vol7d),
INTENT(inout) :: vol7d_out
1983CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: networkname
1984LOGICAL,
OPTIONAL,
INTENT(in) :: noconvert
1986INTEGER :: nntime, nana, ntime, ntimerange, nlevel, nvar, stallo
1987INTEGER :: itime, itimerange, ivar, inetwork
1988REAL,
ALLOCATABLE :: voldatir_out(:,:,:)
1990TYPE(
datetime),
ALLOCATABLE :: validitytime(:,:)
1991REAL,
POINTER :: voldatiin(:,:,:)
1994call l4f_category_log(volgrid6d_in%category,l4f_debug,
"start volgrid6d_v7d_transform_compute")
2003if (
present(networkname))
then
2004 call init(vol7d_out%network(1),name=networkname)
2006 call init(vol7d_out%network(1),name=
'generic')
2009if (
associated(volgrid6d_in%timerange))
then
2010 ntimerange=
size(volgrid6d_in%timerange)
2011 vol7d_out%timerange=volgrid6d_in%timerange
2014if (
associated(volgrid6d_in%time))
then
2015 ntime=
size(volgrid6d_in%time)
2017 if (vol7d_out%time_definition == volgrid6d_in%time_definition)
then
2020 vol7d_out%time=volgrid6d_in%time
2024 allocate (validitytime(ntime,ntimerange),stat=stallo)
2027 call raise_fatal_error()
2031 do itimerange=1,ntimerange
2032 if (vol7d_out%time_definition > volgrid6d_in%time_definition)
then
2033 validitytime(itime,itimerange) = &
2034 volgrid6d_in%time(itime) + timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
2036 validitytime(itime,itimerange) = &
2037 volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
2042 nntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.)
2043 vol7d_out%time=pack_distinct(reshape(validitytime,(/ntime*ntimerange/)), nntime,back=.true.)
2048IF (
ASSOCIATED(volgrid6d_in%level))
THEN
2049 nlevel =
SIZE(volgrid6d_in%level)
2050 vol7d_out%level=volgrid6d_in%level
2053IF (
ASSOCIATED(volgrid6d_in%var))
THEN
2054 nvar =
SIZE(volgrid6d_in%var)
2055 IF (.NOT. optio_log(noconvert))
THEN
2056 CALL vargrib2varbufr(volgrid6d_in%var, vol7d_out%dativar%r, c_func)
2060nana =
SIZE(vol7d_out%ana)
2063IF (.NOT.
ASSOCIATED(volgrid6d_in%voldati))
THEN
2064 ALLOCATE(voldatiin(volgrid6d_in%griddim%dim%nx, volgrid6d_in%griddim%dim%ny, &
2068ALLOCATE(voldatir_out(nana,1,nlevel),stat=stallo)
2069IF (stallo /= 0)
THEN
2071 CALL raise_fatal_error()
2076 do itimerange=1,ntimerange
2088 CALL volgrid_get_vol_3d(volgrid6d_in, itime, itimerange, ivar, &
2091 CALL compute(this, voldatiin, voldatir_out, vol7d_out%dativar%r(ivar))
2093 if (vol7d_out%time_definition == volgrid6d_in%time_definition)
then
2094 vol7d_out%voldatir(:,itime,:,itimerange,ivar,inetwork) = &
2097 vol7d_out%voldatir(:,
index(vol7d_out%time,validitytime(itime,itimerange)),:,itimerange,ivar,inetwork)=&
2098 reshape(voldatir_out,(/nana,nlevel/))
2113deallocate(voldatir_out)
2114IF (.NOT.
ASSOCIATED(volgrid6d_in%voldati))
THEN
2115 DEALLOCATE(voldatiin)
2117if (
allocated(validitytime))
deallocate(validitytime)
2120IF (
ASSOCIATED(c_func))
THEN
2122 CALL compute(c_func(ivar), vol7d_out%voldatir(:,:,:,:,ivar,:))
2127end SUBROUTINE volgrid6d_v7d_transform_compute
2136SUBROUTINE volgrid6d_v7d_transform(this, volgrid6d_in, vol7d_out, v7d, &
2137 maskgrid, maskbounds, networkname, noconvert, find_index, categoryappend)
2139TYPE(
volgrid6d),
INTENT(inout) :: volgrid6d_in
2140TYPE(
vol7d),
INTENT(out) :: vol7d_out
2141TYPE(
vol7d),
INTENT(in),
OPTIONAL :: v7d
2142REAL,
INTENT(in),
OPTIONAL :: maskgrid(:,:)
2143REAL,
INTENT(in),
OPTIONAL :: maskbounds(:)
2144CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: networkname
2145LOGICAL,
OPTIONAL,
INTENT(in) :: noconvert
2146PROCEDURE(basic_find_index),
POINTER,
OPTIONAL :: find_index
2147CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
2150INTEGER :: ntime, ntimerange, nlevel, nvar, nana, time_definition, nnetwork, stallo
2151INTEGER :: itime, itimerange, inetwork
2152TYPE(
datetime),
ALLOCATABLE :: validitytime(:,:)
2153INTEGER,
ALLOCATABLE :: point_index(:)
2154TYPE(
vol7d) :: v7d_locana
2157call l4f_category_log(volgrid6d_in%category,l4f_debug,
"start volgrid6d_v7d_transform")
2160call vg6d_wind_unrot(volgrid6d_in)
2168call get_val(this,time_definition=time_definition)
2169if (.not.
c_e(time_definition))
then
2173IF (
PRESENT(v7d))
THEN
2174 CALL vol7d_copy(v7d, v7d_locana)
2176 CALL init(v7d_locana)
2179if (
associated(volgrid6d_in%timerange)) ntimerange=
size(volgrid6d_in%timerange)
2181if (
associated(volgrid6d_in%time))
then
2183 ntime=
size(volgrid6d_in%time)
2185 if (time_definition /= volgrid6d_in%time_definition)
then
2188 allocate (validitytime(ntime,ntimerange),stat=stallo)
2191 call raise_fatal_error()
2195 do itimerange=1,ntimerange
2196 if (time_definition > volgrid6d_in%time_definition)
then
2197 validitytime(itime,itimerange) = &
2198 volgrid6d_in%time(itime) + timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
2200 validitytime(itime,itimerange) = &
2201 volgrid6d_in%time(itime) - timedelta_new(sec=volgrid6d_in%timerange(itimerange)%p1)
2206 ntime = count_distinct(reshape(validitytime,(/ntime*ntimerange/)), back=.true.)
2207 deallocate (validitytime)
2213if (
associated(volgrid6d_in%level)) nlevel=
size(volgrid6d_in%level)
2214if (
associated(volgrid6d_in%var)) nvar=
size(volgrid6d_in%var)
2216CALL init(grid_trans, this, volgrid6d_in%griddim, v7d_locana, &
2217 maskgrid=maskgrid, maskbounds=maskbounds, find_index=find_index, &
2218 categoryappend=categoryappend)
2219CALL init (vol7d_out,time_definition=time_definition)
2221IF (
c_e(grid_trans))
THEN
2223 nana=
SIZE(v7d_locana%ana)
2224 CALL vol7d_alloc(vol7d_out, nana=nana, ntime=ntime, nlevel=nlevel, &
2225 ntimerange=ntimerange, ndativarr=nvar, nnetwork=nnetwork)
2226 vol7d_out%ana = v7d_locana%ana
2228 CALL get_val(grid_trans, output_point_index=point_index)
2229 IF (
ALLOCATED(point_index))
THEN
2231 CALL vol7d_alloc(vol7d_out, nanavari=1)
2232 CALL init(vol7d_out%anavar%i(1),
'B01192')
2235 CALL vol7d_alloc_vol(vol7d_out)
2237 IF (
ALLOCATED(point_index))
THEN
2238 DO inetwork = 1, nnetwork
2239 vol7d_out%volanai(:,1,inetwork) = point_index(:)
2242 CALL compute(grid_trans, volgrid6d_in, vol7d_out, networkname, noconvert)
2244 CALL l4f_log(l4f_error,
'vg6d_v7d_transform: transformation not valid')
2252CALL vol7d_dballe_set_var_du(vol7d_out)
2257END SUBROUTINE volgrid6d_v7d_transform
2268SUBROUTINE volgrid6dv_v7d_transform(this, volgrid6d_in, vol7d_out, v7d, &
2269 maskgrid, maskbounds, networkname, noconvert, find_index, categoryappend)
2271TYPE(
volgrid6d),
INTENT(inout) :: volgrid6d_in(:)
2272TYPE(
vol7d),
INTENT(out) :: vol7d_out
2273TYPE(
vol7d),
INTENT(in),
OPTIONAL :: v7d
2274REAL,
INTENT(in),
OPTIONAL :: maskgrid(:,:)
2275REAL,
INTENT(in),
OPTIONAL :: maskbounds(:)
2276CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: networkname
2277LOGICAL,
OPTIONAL,
INTENT(in) :: noconvert
2278PROCEDURE(basic_find_index),
POINTER,
OPTIONAL :: find_index
2279CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
2282TYPE(
vol7d) :: v7dtmp
2288DO i=1,
SIZE(volgrid6d_in)
2289 CALL transform(this, volgrid6d_in(i), v7dtmp, v7d=v7d, &
2290 maskgrid=maskgrid, maskbounds=maskbounds, &
2291 networkname=networkname, noconvert=noconvert, find_index=find_index, &
2292 categoryappend=categoryappend)
2293 CALL vol7d_append(vol7d_out, v7dtmp)
2296END SUBROUTINE volgrid6dv_v7d_transform
2300SUBROUTINE v7d_volgrid6d_transform_compute(this, vol7d_in, volgrid6d_out, networkname, gaid_template)
2302type(
vol7d),
INTENT(in) :: vol7d_in
2303type(
volgrid6d),
INTENT(inout) :: volgrid6d_out
2304CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: networkname
2305TYPE(
grid_id),
OPTIONAL,
INTENT(in) :: gaid_template
2307integer :: nana, ntime, ntimerange, nlevel, nvar
2308INTEGER :: ilevel, itime, itimerange, ivar, inetwork
2310REAL,
POINTER :: voldatiout(:,:,:)
2311type(vol7d_network) :: network
2316 'start v7d_volgrid6d_transform_compute')
2324IF (
PRESENT(networkname))
THEN
2325 CALL init(network,name=networkname)
2326 inetwork =
index(vol7d_in%network,network)
2327 IF (inetwork <= 0)
THEN
2329 'network '//trim(networkname)//
' not found, first network will be transformed')
2337if (
associated(vol7d_in%time))
then
2338 ntime=
size(vol7d_in%time)
2339 volgrid6d_out%time=vol7d_in%time
2342if (
associated(vol7d_in%timerange))
then
2343 ntimerange=
size(vol7d_in%timerange)
2344 volgrid6d_out%timerange=vol7d_in%timerange
2347if (
associated(vol7d_in%level))
then
2348 nlevel=
size(vol7d_in%level)
2349 volgrid6d_out%level=vol7d_in%level
2352if (
associated(vol7d_in%dativar%r))
then
2353 nvar=
size(vol7d_in%dativar%r)
2354 CALL varbufr2vargrib(vol7d_in%dativar%r, volgrid6d_out%var, c_func, gaid_template)
2357nana=
SIZE(vol7d_in%voldatir, 1)
2359IF (.NOT.
ASSOCIATED(volgrid6d_out%voldati))
THEN
2360 ALLOCATE(voldatiout(volgrid6d_out%griddim%dim%nx, volgrid6d_out%griddim%dim%ny, &
2365 DO itimerange=1,ntimerange
2369 IF (
PRESENT(gaid_template))
THEN
2370 DO ilevel = 1, nlevel
2371 IF (any(
c_e(vol7d_in%voldatir(:,itime,ilevel,itimerange,ivar,inetwork))))
THEN
2372 CALL copy(gaid_template, volgrid6d_out%gaid(ilevel,itime,itimerange,ivar))
2374 volgrid6d_out%gaid(ilevel,itime,itimerange,ivar) = grid_id_new()
2380 IF (
ASSOCIATED(volgrid6d_out%voldati)) &
2381 CALL volgrid_get_vol_3d(volgrid6d_out, itime, itimerange, ivar, &
2384 CALL compute(this, &
2385 vol7d_in%voldatir(:,itime,:,itimerange,ivar,inetwork), voldatiout, &
2386 vol7d_in%dativar%r(ivar))
2388 IF (
ASSOCIATED(c_func))
THEN
2389 CALL compute(c_func(ivar), voldatiout(:,:,:))
2392 CALL volgrid_set_vol_3d(volgrid6d_out, itime, itimerange, ivar, &
2399IF (.NOT.
ASSOCIATED(volgrid6d_out%voldati))
THEN
2400 DEALLOCATE(voldatiout)
2402IF (
ASSOCIATED(c_func))
THEN
2406END SUBROUTINE v7d_volgrid6d_transform_compute
2415SUBROUTINE v7d_volgrid6d_transform(this, griddim, vol7d_in, volgrid6d_out, &
2416 networkname, gaid_template, categoryappend)
2420TYPE(
vol7d),
INTENT(inout) :: vol7d_in
2421TYPE(
volgrid6d),
INTENT(out) :: volgrid6d_out
2422CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: networkname
2423TYPE(
grid_id),
OPTIONAL,
INTENT(in) :: gaid_template
2424CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
2427integer :: ntime, ntimerange, nlevel, nvar
2433CALL vol7d_alloc_vol(vol7d_in)
2434ntime=
SIZE(vol7d_in%time)
2435ntimerange=
SIZE(vol7d_in%timerange)
2436nlevel=
SIZE(vol7d_in%level)
2438if (
associated(vol7d_in%dativar%r)) nvar=
size(vol7d_in%dativar%r)
2441 CALL l4f_log(l4f_error, &
2442 "trying to transform a vol7d object incomplete or without real variables")
2443 CALL init(volgrid6d_out)
2448CALL init(grid_trans, this, vol7d_in, griddim, categoryappend=categoryappend)
2449CALL init(volgrid6d_out, griddim, time_definition=vol7d_in%time_definition, &
2450 categoryappend=categoryappend)
2452IF (
c_e(grid_trans))
THEN
2454 CALL volgrid6d_alloc(volgrid6d_out, griddim%dim, ntime=ntime, nlevel=nlevel, &
2455 ntimerange=ntimerange, nvar=nvar)
2457 CALL volgrid6d_alloc_vol(volgrid6d_out, decode=.true.)
2459 CALL compute(grid_trans, vol7d_in, volgrid6d_out, networkname, gaid_template)
2461 CALL vg6d_wind_rot(volgrid6d_out)
2464 CALL l4f_log(l4f_error,
'v7d_vg6d_transform: transformation not valid')
2470END SUBROUTINE v7d_volgrid6d_transform
2474SUBROUTINE v7d_v7d_transform_compute(this, vol7d_in, vol7d_out, lev_out, &
2477type(
vol7d),
INTENT(in) :: vol7d_in
2478type(
vol7d),
INTENT(inout) :: vol7d_out
2479TYPE(
vol7d_level),
INTENT(in),
OPTIONAL :: lev_out(:)
2480INTEGER,
INTENT(in),
OPTIONAL :: var_coord_vol
2482INTEGER :: itime, itimerange, ilevel, ivar, inetwork, &
2483 levshift, levused, lvar_coord_vol, spos
2484REAL,
ALLOCATABLE :: coord_3d_in(:,:,:)
2487lvar_coord_vol = optio_i(var_coord_vol)
2488vol7d_out%time(:) = vol7d_in%time(:)
2489vol7d_out%timerange(:) = vol7d_in%timerange(:)
2490IF (
PRESENT(lev_out))
THEN
2491 vol7d_out%level(:) = lev_out(:)
2493 vol7d_out%level(:) = vol7d_in%level(:)
2495vol7d_out%network(:) = vol7d_in%network(:)
2496IF (
ASSOCIATED(vol7d_in%dativar%r))
THEN
2497 vol7d_out%dativar%r(:) = vol7d_in%dativar%r(:)
2499 CALL get_val(this, levshift=levshift, levused=levused)
2501 IF (
c_e(lvar_coord_vol))
THEN
2502 CALL get_val(this%trans, output_levtype=output_levtype)
2503 IF (output_levtype%level1 == 103 .OR. output_levtype%level1 == 108)
THEN
2504 spos = firsttrue(vol7d_in%level(:) == vol7d_level_new(1))
2506 CALL l4f_log(l4f_error, &
2507 'output level '//
t2c(output_levtype%level1)// &
2508 ' requested, but height/press of surface not provided in volume')
2510 IF (.NOT.
c_e(levshift) .AND. .NOT.
c_e(levused))
THEN
2511 CALL l4f_log(l4f_error, &
2512 'internal inconsistence, levshift and levused undefined when they should be')
2514 ALLOCATE(coord_3d_in(
SIZE(vol7d_in%ana),1,
SIZE(vol7d_in%level)))
2519 DO inetwork = 1,
SIZE(vol7d_in%network)
2520 DO ivar = 1,
SIZE(vol7d_in%dativar%r)
2521 DO itimerange = 1,
SIZE(vol7d_in%timerange)
2522 DO itime = 1,
SIZE(vol7d_in%time)
2525 IF (
c_e(lvar_coord_vol))
THEN
2528 coord_3d_in(:,:,levshift+1:levshift+levused) = rmiss
2530 DO ilevel = levshift+1, levshift+levused
2531 WHERE(
c_e(vol7d_in%voldatir(:,itime:itime,ilevel,itimerange,lvar_coord_vol,inetwork)) .AND. &
2532 c_e(vol7d_in%voldatir(:,itime:itime,spos,itimerange,lvar_coord_vol,inetwork)))
2533 coord_3d_in(:,:,ilevel) = vol7d_in%voldatir(:,itime:itime,ilevel,itimerange,lvar_coord_vol,inetwork) - &
2534 vol7d_in%voldatir(:,itime:itime,spos,itimerange,lvar_coord_vol,inetwork)
2536 coord_3d_in(:,:,ilevel) = rmiss
2540 CALL compute(this, &
2541 vol7d_in%voldatir(:,itime,:,itimerange,ivar,inetwork), &
2542 vol7d_out%voldatir(:,itime:itime,:,itimerange,ivar,inetwork), &
2543 var=vol7d_in%dativar%r(ivar), &
2544 coord_3d_in=coord_3d_in)
2546 CALL compute(this, &
2547 vol7d_in%voldatir(:,itime,:,itimerange,ivar,inetwork), &
2548 vol7d_out%voldatir(:,itime:itime,:,itimerange,ivar,inetwork), &
2549 var=vol7d_in%dativar%r(ivar), &
2550 coord_3d_in=vol7d_in%voldatir(:,itime:itime,:,itimerange, &
2551 lvar_coord_vol,inetwork))
2554 CALL compute(this, &
2555 vol7d_in%voldatir(:,itime,:,itimerange,ivar,inetwork), &
2556 vol7d_out%voldatir(:,itime:itime,:,itimerange,ivar,inetwork), &
2557 var=vol7d_in%dativar%r(ivar))
2566END SUBROUTINE v7d_v7d_transform_compute
2576SUBROUTINE v7d_v7d_transform(this, vol7d_in, vol7d_out, v7d, maskbounds, &
2577 lev_out, vol7d_coord_in, categoryappend)
2579TYPE(
vol7d),
INTENT(inout) :: vol7d_in
2580TYPE(
vol7d),
INTENT(out) :: vol7d_out
2581TYPE(
vol7d),
INTENT(in),
OPTIONAL :: v7d
2582REAL,
INTENT(in),
OPTIONAL :: maskbounds(:)
2583TYPE(
vol7d_level),
INTENT(in),
OPTIONAL,
TARGET :: lev_out(:)
2584TYPE(
vol7d),
INTENT(in),
OPTIONAL :: vol7d_coord_in
2585CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
2587INTEGER :: nvar, inetwork
2591TYPE(vol7d_var) :: vcoord_var
2592REAL,
ALLOCATABLE :: coord_3d_in(:,:,:)
2593INTEGER :: var_coord_in, var_coord_vol, i, k, ulstart, ulend, spos
2594INTEGER,
ALLOCATABLE :: point_index(:)
2595TYPE(
vol7d) :: v7d_locana, vol7d_tmpana
2596CHARACTER(len=80) :: trans_type
2597LOGICAL,
ALLOCATABLE :: mask_in(:), point_mask(:)
2599CALL vol7d_alloc_vol(vol7d_in)
2601IF (
ASSOCIATED(vol7d_in%dativar%r)) nvar=
SIZE(vol7d_in%dativar%r)
2604IF (
PRESENT(v7d)) v7d_locana = v7d
2605CALL init(vol7d_out, time_definition=vol7d_in%time_definition)
2607CALL get_val(this, trans_type=trans_type)
2609var_coord_vol = imiss
2610IF (trans_type ==
'vertint')
THEN
2612 IF (
PRESENT(lev_out))
THEN
2616 IF (
PRESENT(vol7d_coord_in))
THEN
2617 IF (
ASSOCIATED(vol7d_coord_in%voldatir) .AND. &
2618 ASSOCIATED(vol7d_coord_in%dativar%r))
THEN
2621 IF (
SIZE(vol7d_coord_in%voldatir,2) /= 1 .OR. &
2622 SIZE(vol7d_coord_in%voldatir,4) /= 1 .OR. &
2623 SIZE(vol7d_coord_in%voldatir,6) /= 1)
THEN
2624 CALL l4f_log(l4f_error, &
2625 'volume providing constant input vertical coordinate must have &
2626 &only 1 time, 1 timerange and 1 network')
2632 CALL get_val(this, output_levtype=output_levtype)
2634 IF (.NOT.
c_e(vcoord_var))
THEN
2635 CALL l4f_log(l4f_error, &
2636 'requested output level type '//
t2c(output_levtype%level1)// &
2637 ' does not correspond to any known physical variable for &
2638 &providing vertical coordinate')
2643 var_coord_in =
index(vol7d_coord_in%dativar%r, vcoord_var)
2645 IF (var_coord_in <= 0)
THEN
2646 CALL l4f_log(l4f_error, &
2647 'volume providing constant input vertical coordinate contains no &
2648 &real variables matching output level type '//
t2c(output_levtype%level1))
2652 CALL l4f_log(l4f_info, &
2653 'Coordinate for vertint found in coord volume at position '// &
2657 CALL get_val(this, input_levtype=input_levtype)
2659 (vol7d_coord_in%level(:)%level1 == input_levtype%level1) .AND. &
2660 (vol7d_coord_in%level(:)%level2 == input_levtype%level2)
2661 ulstart = firsttrue(mask_in)
2662 ulend = lasttrue(mask_in)
2663 IF (ulstart == 0 .OR. ulend == 0)
THEN
2664 CALL l4f_log(l4f_error, &
2665 'coordinate file does not contain levels of type '// &
2666 t2c(input_levtype%level1)//
'/'//
t2c(input_levtype%level2)// &
2667 ' specified for input data')
2672 coord_3d_in = vol7d_coord_in%voldatir(:,1:1,ulstart:ulend,1,var_coord_in,1)
2674 IF (output_levtype%level1 == 103 &
2675 .OR. output_levtype%level1 == 108)
THEN
2676 spos = firsttrue(vol7d_coord_in%level(:) == vol7d_level_new(1))
2678 CALL l4f_log(l4f_error, &
2679 'output level '//
t2c(output_levtype%level1)// &
2680 ' requested, but height/press of surface not provided in coordinate file')
2684 DO k = 1,
SIZE(coord_3d_in,3)
2685 WHERE(
c_e(coord_3d_in(:,:,k)) .AND. &
2686 c_e(vol7d_coord_in%voldatir(:,1:1,spos,1,var_coord_in,1)))
2687 coord_3d_in(:,:,k) = coord_3d_in(:,:,k) - &
2688 vol7d_coord_in%voldatir(:,1:1,spos,1,var_coord_in,1)
2690 coord_3d_in(:,:,k) = rmiss
2698 IF (var_coord_in <= 0)
THEN
2700 CALL get_val(this, output_levtype=output_levtype)
2702 IF (
c_e(vcoord_var))
THEN
2703 DO i = 1,
SIZE(vol7d_in%dativar%r)
2704 IF (vol7d_in%dativar%r(i) == vcoord_var)
THEN
2710 IF (
c_e(var_coord_vol))
THEN
2711 CALL l4f_log(l4f_info, &
2712 'Coordinate for vertint found in input volume at position '// &
2719 IF (var_coord_in > 0)
THEN
2720 CALL init(grid_trans, this, lev_in=vol7d_in%level, lev_out=lev_out, &
2721 coord_3d_in=coord_3d_in, categoryappend=categoryappend)
2723 CALL init(grid_trans, this, lev_in=vol7d_in%level, lev_out=lev_out, &
2724 categoryappend=categoryappend)
2727 CALL get_val(grid_trans, output_level_auto=llev_out)
2728 IF (.NOT.
associated(llev_out)) llev_out => lev_out
2730 IF (
c_e(grid_trans)) then
2732 CALL vol7d_alloc(vol7d_out, nana=
SIZE(vol7d_in%ana), &
2733 ntime=
SIZE(vol7d_in%time), ntimerange=
SIZE(vol7d_in%timerange), &
2734 nlevel=
SIZE(llev_out), nnetwork=
SIZE(vol7d_in%network), ndativarr=nvar)
2735 vol7d_out%ana(:) = vol7d_in%ana(:)
2737 CALL vol7d_alloc_vol(vol7d_out)
2742 CALL compute(grid_trans, vol7d_in, vol7d_out, llev_out, &
2743 var_coord_vol=var_coord_vol)
2745 CALL l4f_log(l4f_error,
'v7d_v7d_transform: transformation not valid')
2749 CALL l4f_log(l4f_error, &
2750 'v7d_v7d_transform: vertint requested but lev_out not provided')
2756 CALL init(grid_trans, this, vol7d_in, v7d_locana, maskbounds=maskbounds, &
2757 categoryappend=categoryappend)
2760 IF (
c_e(grid_trans)) then
2762 CALL vol7d_alloc(vol7d_out, nana=
SIZE(v7d_locana%ana), &
2763 ntime=
SIZE(vol7d_in%time), ntimerange=
SIZE(vol7d_in%timerange), &
2764 nlevel=
SIZE(vol7d_in%level), nnetwork=
SIZE(vol7d_in%network), ndativarr=nvar)
2765 vol7d_out%ana = v7d_locana%ana
2767 CALL get_val(grid_trans, point_mask=point_mask, output_point_index=point_index)
2769 IF (
ALLOCATED(point_index))
THEN
2770 CALL vol7d_alloc(vol7d_out, nanavari=1)
2771 CALL init(vol7d_out%anavar%i(1),
'B01192')
2774 CALL vol7d_alloc_vol(vol7d_out)
2776 IF (
ALLOCATED(point_index))
THEN
2777 DO inetwork = 1,
SIZE(vol7d_in%network)
2778 vol7d_out%volanai(:,1,inetwork) = point_index(:)
2781 CALL compute(grid_trans, vol7d_in, vol7d_out)
2783 IF (
ALLOCATED(point_mask))
THEN
2784 IF (
SIZE(point_mask) /=
SIZE(vol7d_in%ana))
THEN
2785 CALL l4f_log(l4f_warn, &
2786 'v7d_v7d_transform: inconsistency in point size: '//
t2c(
SIZE(point_mask)) &
2787 //
':'//
t2c(
SIZE(vol7d_in%ana)))
2790 CALL l4f_log(l4f_debug,
'v7d_v7d_transform: merging ana from in to out')
2792 CALL vol7d_copy(vol7d_in, vol7d_tmpana, &
2793 lana=point_mask, lnetwork=(/.true./), &
2794 ltime=(/.false./), ltimerange=(/.false./), llevel=(/.false./))
2795 CALL vol7d_append(vol7d_out, vol7d_tmpana)
2800 CALL l4f_log(l4f_error,
'v7d_v7d_transform: transformation not valid')
2807IF (.NOT.
PRESENT(v7d))
CALL delete(v7d_locana)
2809END SUBROUTINE v7d_v7d_transform
2819subroutine vg6d_wind_unrot(this)
2822integer :: component_flag
2824call get_val(this%griddim,component_flag=component_flag)
2826if (component_flag == 1)
then
2828 "unrotating vector components")
2829 call vg6d_wind__un_rot(this,.false.)
2830 call set_val(this%griddim,component_flag=0)
2833 "no need to unrotate vector components")
2836end subroutine vg6d_wind_unrot
2844subroutine vg6d_wind_rot(this)
2847integer :: component_flag
2849call get_val(this%griddim,component_flag=component_flag)
2851if (component_flag == 0)
then
2853 "rotating vector components")
2854 call vg6d_wind__un_rot(this,.true.)
2855 call set_val(this%griddim,component_flag=1)
2858 "no need to rotate vector components")
2861end subroutine vg6d_wind_rot
2865SUBROUTINE vg6d_wind__un_rot(this,rot)
2869INTEGER :: i, j, k, l, a11, a12, a21, a22, stallo
2870double precision,
pointer :: rot_mat(:,:,:)
2871real,
allocatable :: tmp_arr(:,:)
2872REAL,
POINTER :: voldatiu(:,:), voldativ(:,:)
2873INTEGER,
POINTER :: iu(:), iv(:)
2875IF (.NOT.
ASSOCIATED(this%var))
THEN
2877 "trying to unrotate an incomplete volgrid6d object")
2878 CALL raise_fatal_error()
2882CALL volgrid6d_var_hor_comp_index(this%var, iu, iv)
2883IF (.NOT.
ASSOCIATED(iu))
THEN
2885 "unrotation impossible")
2886 CALL raise_fatal_error()
2891ALLOCATE(tmp_arr(this%griddim%dim%nx, this%griddim%dim%ny),stat=stallo)
2892IF (stallo /= 0)
THEN
2894 CALL raise_fatal_error()
2897IF (.NOT.
ASSOCIATED(this%voldati))
THEN
2898 ALLOCATE(voldatiu(this%griddim%dim%nx, this%griddim%dim%ny), &
2899 voldativ(this%griddim%dim%nx, this%griddim%dim%ny))
2902CALL griddim_unproj(this%griddim)
2903CALL wind_unrot(this%griddim, rot_mat)
2916 DO k = 1,
SIZE(this%timerange)
2917 DO j = 1,
SIZE(this%time)
2918 DO i = 1,
SIZE(this%level)
2920 CALL volgrid_get_vol_2d(this, i, j, k, iu(l), voldatiu)
2921 CALL volgrid_get_vol_2d(this, i, j, k, iv(l), voldativ)
2927 WHERE(voldatiu /= rmiss .AND. voldativ /= rmiss)
2928 tmp_arr(:,:) = real(voldatiu(:,:)*rot_mat(:,:,a11) + &
2929 voldativ(:,:)*rot_mat(:,:,a12))
2930 voldativ(:,:) = real(voldatiu(:,:)*rot_mat(:,:,a21) + &
2931 voldativ(:,:)*rot_mat(:,:,a22))
2932 voldatiu(:,:) = tmp_arr(:,:)
2938 CALL volgrid_set_vol_2d(this, i, j, k, iu(l), voldatiu)
2939 CALL volgrid_set_vol_2d(this, i, j, k, iv(l), voldativ)
2945IF (.NOT.
ASSOCIATED(this%voldati))
THEN
2946 DEALLOCATE(voldatiu, voldativ)
2948DEALLOCATE(rot_mat, tmp_arr, iu, iv)
2950END SUBROUTINE vg6d_wind__un_rot
2996subroutine vg6d_c2a (this)
3000integer :: ngrid,igrid,jgrid,ugrid,vgrid,tgrid
3001doubleprecision :: xmin, xmax, ymin, ymax
3002doubleprecision :: xmin_t, xmax_t, ymin_t, ymax_t
3003doubleprecision :: step_lon_t,step_lat_t
3004character(len=80) :: type_t,type
3011 call init(griddim_t)
3013 call get_val(this(igrid)%griddim,xmin=xmin_t, xmax=xmax_t, ymin=ymin_t, ymax=ymax_t,proj_type=type_t)
3014 step_lon_t=(xmax_t-xmin_t)/dble(this(igrid)%griddim%dim%nx-1)
3015 step_lat_t=(ymax_t-ymin_t)/dble(this(igrid)%griddim%dim%ny-1)
3028 if (this(igrid)%griddim == this(jgrid)%griddim ) cycle
3030 if (this(igrid)%griddim%dim%nx == this(jgrid)%griddim%dim%nx .and. &
3031 this(igrid)%griddim%dim%ny == this(jgrid)%griddim%dim%ny )
then
3033 call get_val(this(jgrid)%griddim,xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax,proj_type=type)
3035 if (type_t /=
type )cycle
3041 call l4f_category_log(this(igrid)%category,l4f_debug,
"diff coordinate lon"//&
3042 to_char(
abs(xmin - (xmin_t+step_lon_t/2.d0)))//&
3043 to_char(
abs(xmax - (xmax_t+step_lon_t/2.d0))))
3044 call l4f_category_log(this(igrid)%category,l4f_debug,
"diff coordinate lat"//&
3045 to_char(
abs(ymin - (ymin_t+step_lat_t/2.d0)))//&
3046 to_char(
abs(ymax - (ymax_t+step_lat_t/2.d0))))
3049 if (
abs(xmin - (xmin_t+step_lon_t/2.d0)) < 1.d-3 .and.
abs(xmax - (xmax_t+step_lon_t/2.d0)) < 1.d-3 )
then
3050 if (
abs(ymin - ymin_t) < 1.d-3 .and.
abs(ymax - ymax_t) < 1.d-3 )
then
3066 if (
abs(ymin - (ymin_t+step_lat_t/2.d0)) < 1.d-3 .and.
abs(ymax - (ymax_t+step_lat_t/2.d0)) < 1.d-3 )
then
3067 if (
abs(xmin - xmin_t) < 1.d-3 .and.
abs(xmax - xmax_t) < 1.d-3 )
then
3082 call l4f_category_log(this(igrid)%category,l4f_debug,
"C grid: test U and V"//&
3086 call l4f_category_log(this(igrid)%category,l4f_debug,
"UV diff coordinate lon"//&
3087 to_char(
abs(xmin_t - xmin)-step_lon_t/2.d0)//&
3089 call l4f_category_log(this(igrid)%category,l4f_debug,
"UV diff coordinate lat"//&
3090 to_char(
abs(ymin_t - ymin) -step_lat_t/2.d0)//&
3094 if (
abs(ymin - (ymin_t+step_lat_t/2.d0)) < 2.d-3 .and.
abs(ymax - (ymax_t+step_lat_t/2.d0)) < 2.d-3 )
then
3095 if (
abs(xmin_t - (xmin+step_lon_t/2.d0)) < 2.d-3 .and.
abs(xmax_t - (xmax+step_lon_t/2.d0)) < 2.d-3 )
then
3098 call l4f_category_log(this(igrid)%category,l4f_debug,
"C grid: found U and V case up and right")
3104 call init(griddim_t,xmin=xmin, xmax=xmax, ymin=ymin_t, ymax=ymax_t)
3111 if (
c_e(ugrid))
then
3116 call vg6d_c2a_grid(this(ugrid),this(tgrid)%griddim,cgrid=1)
3118 call vg6d_c2a_grid(this(ugrid),griddim_t,cgrid=1)
3120 call vg6d_c2a_mat(this(ugrid),cgrid=1)
3123 if (
c_e(vgrid))
then
3128 call vg6d_c2a_grid(this(vgrid),this(tgrid)%griddim,cgrid=2)
3130 call vg6d_c2a_grid(this(vgrid),griddim_t,cgrid=2)
3132 call vg6d_c2a_mat(this(vgrid),cgrid=2)
3142end subroutine vg6d_c2a
3146subroutine vg6d_c2a_grid(this,griddim_t,cgrid)
3150integer,
intent(in) :: cgrid
3152doubleprecision :: xmin, xmax, ymin, ymax
3153doubleprecision :: step_lon,step_lat
3156if (
present(griddim_t))
then
3158 call get_val(griddim_t,xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
3159 call set_val(this%griddim,xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
3161 CALL griddim_setsteps(this%griddim)
3170 call l4f_category_log(this%category,l4f_debug,
"C grid: T points, nothing to do")
3177 call l4f_category_log(this%category,l4f_debug,
"C grid: U points, we need interpolation")
3180 call get_val(this%griddim, xmin=xmin, xmax=xmax)
3181 step_lon=(xmax-xmin)/dble(this%griddim%dim%nx-1)
3182 xmin=xmin-step_lon/2.d0
3183 xmax=xmax-step_lon/2.d0
3186 CALL griddim_setsteps(this%griddim)
3191 call l4f_category_log(this%category,l4f_debug,
"C grid: V points, we need interpolation")
3194 call get_val(this%griddim, ymin=ymin, ymax=ymax)
3195 step_lat=(ymax-ymin)/dble(this%griddim%dim%ny-1)
3196 ymin=ymin-step_lat/2.d0
3197 ymax=ymax-step_lat/2.d0
3198 call set_val(this%griddim, ymin=ymin, ymax=ymax)
3200 CALL griddim_setsteps(this%griddim)
3205 call raise_fatal_error ()
3212call griddim_unproj(this%griddim)
3215end subroutine vg6d_c2a_grid
3218subroutine vg6d_c2a_mat(this,cgrid)
3221integer,
intent(in) :: cgrid
3223INTEGER :: i, j, k, iv, stallo
3224REAL,
ALLOCATABLE :: tmp_arr(:,:)
3225REAL,
POINTER :: voldatiuv(:,:)
3228IF (cgrid == 0)
RETURN
3229IF (cgrid /= 1 .AND. cgrid /= 2)
THEN
3231 trim(
to_char(cgrid))//
" not known")
3237ALLOCATE(tmp_arr(this%griddim%dim%nx, this%griddim%dim%ny),stat=stallo)
3239 call l4f_log(l4f_fatal,
"allocating memory")
3240 call raise_fatal_error()
3244IF (.NOT.
ASSOCIATED(this%voldati))
THEN
3245 ALLOCATE(voldatiuv(this%griddim%dim%nx, this%griddim%dim%ny), stat=stallo)
3246 IF (stallo /= 0)
THEN
3247 CALL l4f_log(l4f_fatal,
"allocating memory")
3248 CALL raise_fatal_error()
3253 DO iv = 1,
SIZE(this%var)
3254 DO k = 1,
SIZE(this%timerange)
3255 DO j = 1,
SIZE(this%time)
3256 DO i = 1,
SIZE(this%level)
3257 tmp_arr(:,:) = rmiss
3258 CALL volgrid_get_vol_2d(this, i, j, k, iv, voldatiuv)
3261 WHERE(voldatiuv(1,:) /= rmiss .AND. voldatiuv(2,:) /= rmiss)
3262 tmp_arr(1,:) = voldatiuv(1,:) - (voldatiuv(2,:) - voldatiuv(1,:)) / 2.
3266 WHERE(voldatiuv(1:this%griddim%dim%nx-1,:) /= rmiss .AND. &
3267 voldatiuv(2:this%griddim%dim%nx,:) /= rmiss)
3268 tmp_arr(2:this%griddim%dim%nx,:) = &
3269 (voldatiuv(1:this%griddim%dim%nx-1,:) + &
3270 voldatiuv(2:this%griddim%dim%nx,:)) / 2.
3273 voldatiuv(:,:) = tmp_arr
3274 CALL volgrid_set_vol_2d(this, i, j, k, iv, voldatiuv)
3280ELSE IF (cgrid == 2)
THEN
3281 DO iv = 1,
SIZE(this%var)
3282 DO k = 1,
SIZE(this%timerange)
3283 DO j = 1,
SIZE(this%time)
3284 DO i = 1,
SIZE(this%level)
3285 tmp_arr(:,:) = rmiss
3286 CALL volgrid_get_vol_2d(this, i, j, k, iv, voldatiuv)
3289 WHERE(voldatiuv(:,1) /= rmiss .AND. voldatiuv(:,2) /= rmiss)
3290 tmp_arr(:,1) = voldatiuv(:,1) - (voldatiuv(:,2) - voldatiuv(:,1)) / 2.
3294 WHERE(voldatiuv(:,1:this%griddim%dim%ny-1) /= rmiss .AND. &
3295 voldatiuv(:,2:this%griddim%dim%ny) /= rmiss)
3296 tmp_arr(:,2:this%griddim%dim%ny) = &
3297 (voldatiuv(:,1:this%griddim%dim%ny-1) + &
3298 voldatiuv(:,2:this%griddim%dim%ny)) / 2.
3301 voldatiuv(:,:) = tmp_arr
3302 CALL volgrid_set_vol_2d(this, i, j, k, iv, voldatiuv)
3309IF (.NOT.
ASSOCIATED(this%voldati))
THEN
3310 DEALLOCATE(voldatiuv)
3314end subroutine vg6d_c2a_mat
3320subroutine display_volgrid6d (this)
3329print*,
"----------------------- volgrid6d display ---------------------"
3332IF (
ASSOCIATED(this%time))
then
3333 print*,
"---- time vector ----"
3334 print*,
"elements=",
size(this%time)
3335 do i=1,
size(this%time)
3340IF (
ASSOCIATED(this%timerange))
then
3341 print*,
"---- timerange vector ----"
3342 print*,
"elements=",
size(this%timerange)
3343 do i=1,
size(this%timerange)
3344 call display(this%timerange(i))
3348IF (
ASSOCIATED(this%level))
then
3349 print*,
"---- level vector ----"
3350 print*,
"elements=",
size(this%level)
3351 do i=1,
size(this%level)
3356IF (
ASSOCIATED(this%var))
then
3357 print*,
"---- var vector ----"
3358 print*,
"elements=",
size(this%var)
3359 do i=1,
size(this%var)
3364IF (
ASSOCIATED(this%gaid))
then
3365 print*,
"---- gaid vector (present mask only) ----"
3366 print*,
"elements=",shape(this%gaid)
3367 print*,
c_e(reshape(this%gaid,(/
SIZE(this%gaid)/)))
3370print*,
"--------------------------------------------------------------"
3373end subroutine display_volgrid6d
3379subroutine display_volgrid6dv (this)
3384print*,
"----------------------- volgrid6d vector ---------------------"
3386print*,
"elements=",
size(this)
3391 call l4f_category_log(this(i)%category,l4f_debug,
"ora mostro il vettore volgrid6d" )
3397print*,
"--------------------------------------------------------------"
3399end subroutine display_volgrid6dv
3404subroutine vg6dv_rounding(vg6din,vg6dout,level,timerange,nostatproc,merge)
3406type(
volgrid6d),
intent(out),
pointer :: vg6dout(:)
3409logical,
intent(in),
optional :: merge
3410logical,
intent(in),
optional :: nostatproc
3414allocate(vg6dout(
size(vg6din)))
3416do i = 1,
size(vg6din)
3417 call vg6d_rounding(vg6din(i),vg6dout(i),level,timerange,nostatproc,merge)
3420end subroutine vg6dv_rounding
3433subroutine vg6d_rounding(vg6din,vg6dout,level,timerange,nostatproc,merge)
3438logical,
intent(in),
optional :: merge
3440logical,
intent(in),
optional :: nostatproc
3442integer :: ilevel,itimerange
3443type(
vol7d_level) :: roundlevel(size(vg6din%level))
3446roundlevel=vg6din%level
3448if (
present(level))
then
3449 do ilevel = 1,
size(vg6din%level)
3450 if ((any(vg6din%level(ilevel) .almosteq. level)))
then
3451 roundlevel(ilevel)=level(1)
3456roundtimerange=vg6din%timerange
3458if (
present(timerange))
then
3459 do itimerange = 1,
size(vg6din%timerange)
3460 if ((any(vg6din%timerange(itimerange) .almosteq. timerange)))
then
3461 roundtimerange(itimerange)=timerange(1)
3468if (optio_log(nostatproc))
then
3469 roundtimerange(:)%timerange=254
3470 roundtimerange(:)%p2=0
3474call vg6d_reduce(vg6din,vg6dout,roundlevel,roundtimerange,merge)
3476end subroutine vg6d_rounding
3486subroutine vg6d_reduce(vg6din,vg6dout,roundlevel,roundtimerange,merge)
3491logical,
intent(in),
optional :: merge
3493integer :: nlevel,ntime,ntimerange,nvar,ilevel,itimerange,ivar,indl,indt,itime,nx,ny
3494real,
allocatable :: vol2d(:,:)
3496nx=vg6din%griddim%dim%nx
3497ny=vg6din%griddim%dim%ny
3498nlevel=count_distinct(roundlevel,back=.true.)
3499ntime=
size(vg6din%time)
3500ntimerange=count_distinct(roundtimerange,back=.true.)
3501nvar=
size(vg6din%var)
3503call init(vg6dout, vg6din%griddim, vg6din%time_definition, categoryappend=
"generated by vg6d_reduce")
3504call volgrid6d_alloc(vg6dout, vg6din%griddim%dim, ntime, nlevel, ntimerange, nvar)
3506if (
ASSOCIATED(vg6din%voldati) .or. optio_log(merge))
then
3507 call volgrid6d_alloc_vol(vg6dout,inivol=.true.,decode=.true.)
3508 allocate(vol2d(nx,ny))
3510 call volgrid6d_alloc_vol(vg6dout,inivol=.true.,decode=.false.)
3513vg6dout%time=vg6din%time
3514vg6dout%var=vg6din%var
3515vg6dout%timerange=pack_distinct(roundtimerange,ntimerange,back=.true.)
3516vg6dout%level=pack_distinct(roundlevel,nlevel,back=.true.)
3518CALL sort(vg6dout%timerange)
3519CALL sort(vg6dout%level)
3521do ilevel=1,
size(vg6din%level)
3522 indl=
index(vg6dout%level,roundlevel(ilevel))
3523 do itimerange=1,
size(vg6din%timerange)
3524 indt=
index(vg6dout%timerange,roundtimerange(itimerange))
3528 if (
ASSOCIATED(vg6din%voldati))
then
3529 vol2d=vg6din%voldati(:,:,ilevel,itime,itimerange,ivar)
3532 if (optio_log(merge))
then
3534 if ( .not.
ASSOCIATED(vg6din%voldati))
then
3535 CALL grid_id_decode_data(vg6din%gaid(ilevel,itime,itimerange,ivar), vol2d)
3539 where (.not.
c_e(vg6dout%voldati(:,:,indl,itime,indt,ivar)))
3541 vg6dout%voldati(:,:,indl,itime,indt,ivar)=vol2d
3544 else if (
ASSOCIATED(vg6din%voldati))
then
3545 if (.not. any(
c_e(vg6dout%voldati(:,:,indl,itime,indt,ivar))))
then
3546 vg6dout%voldati(:,:,indl,itime,indt,ivar)=vol2d
3550 if (
c_e(vg6din%gaid(ilevel,itime,itimerange,ivar)).and. .not.
c_e(vg6dout%gaid(indl,itime,indt,ivar)))
then
3551 call copy (vg6din%gaid(ilevel,itime,itimerange,ivar), vg6dout%gaid(indl,itime,indt,ivar))
3558if (
ASSOCIATED(vg6din%voldati) .or. optio_log(merge))
then
3562end subroutine vg6d_reduce
Method for inserting elements of the array at a desired position.
Operatore di valore assoluto di un intervallo.
Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o...
Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ...
Copy an object, creating a fully new instance.
Method for returning the contents of the object.
Compute forward coordinate transformation from geographical system to projected system.
Method for setting the contents of the object.
Clone the object, creating a new independent instance of the object exactly equal to the starting one...
Decode and return the data array from a grid_id object associated to a gridinfo object.
Encode a data array into a grid_id object associated to a gridinfo object.
Emit log message for a category with specific priority.
Convert a level type to a physical variable.
Destructor, it releases every information and memory buffer associated with the object.
Display on standard output a description of the volgrid6d object provided.
Export an object dirctly to a native file, to a gridinfo object or to a supported file format through...
Import an object dirctly from a native file, from a gridinfo object or from a supported file format t...
Constructor, it creates a new instance of the object.
Reduce some dimensions (level and timerage) for semplification (rounding).
Apply the conversion function this to values.
This module defines usefull general purpose function and subroutine.
Classi per la gestione delle coordinate temporali.
Module for describing geographically referenced regular grids.
Module for defining the extension and coordinates of a rectangular georeferenced grid.
This module defines an abstract interface to different drivers for access to files containing gridded...
Class for managing information about a single gridded georeferenced field, typically imported from an...
classe per la gestione del logging
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione di un volume completo di dati osservati.
classe per import ed export di volumi da e in DB-All.e
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
This module defines objects and methods for managing data volumes on rectangular georeferenced grids.
Class for managing physical variables in a grib 1/2 fashion.
Class for expressing an absolute time value.
This object completely describes a grid on a geographic projection.
Derived type describing the extension of a grid and the geographical coordinates of each point.
Derived type associated to a block/message/record/band of gridded data coming from a file-like object...
Derived type defining a dynamically extensible array of TYPE(gridinfo_def) elements.
Object describing a single gridded message/band.
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...
Definisce il livello verticale di un'osservazione.
Definisce l'intervallo temporale di un'osservazione meteo.
Object describing a rectangular, homogeneous gridded dataset.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.