Changeset 3554 for palm/trunk/SOURCE/data_output_3d.f90
- Timestamp:
- Nov 22, 2018 11:24:52 AM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_3d.f90
r3525 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! add variable description; rename variable 'if' into 'ivar' 28 ! 29 ! 3525 2018-11-14 16:06:14Z kanani 27 30 ! Changes related to clean-up of biometeorology (dom_dwd_user) 28 31 ! … … 310 313 IMPLICIT NONE 311 314 312 INTEGER(iwp) :: av !< 315 INTEGER(iwp) :: av !< flag for (non-)average output 313 316 INTEGER(iwp) :: flag_nr !< number of masking flag 314 INTEGER(iwp) :: i !< 315 INTEGER(iwp) :: i f !<316 INTEGER(iwp) :: j !< 317 INTEGER(iwp) :: k !< 318 INTEGER(iwp) :: n !< 317 INTEGER(iwp) :: i !< loop index 318 INTEGER(iwp) :: ivar !< variable index 319 INTEGER(iwp) :: j !< loop index 320 INTEGER(iwp) :: k !< loop index 321 INTEGER(iwp) :: n !< loop index 319 322 INTEGER(iwp) :: nzb_do !< vertical lower limit for data output 320 323 INTEGER(iwp) :: nzt_do !< vertical upper limit for data output 321 324 322 LOGICAL :: found !< 323 LOGICAL :: resorted !< 324 325 REAL(wp) :: mean_r !< 326 REAL(wp) :: s_r2 !< 327 REAL(wp) :: s_r3 !< 328 329 REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< 330 331 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< 325 LOGICAL :: found !< true if output variable was found 326 LOGICAL :: resorted !< true if variable is resorted 327 328 REAL(wp) :: mean_r !< mean particle radius 329 REAL(wp) :: s_r2 !< sum( particle-radius**2 ) 330 REAL(wp) :: s_r3 !< sum( particle-radius**3 ) 331 332 REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array 333 334 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer to array which shall be output 332 335 333 336 CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string … … 387 390 ! 388 391 !-- Loop over all variables to be written. 389 i f= 1390 391 DO WHILE ( do3d(av,i f)(1:1) /= ' ' )392 ivar = 1 393 394 DO WHILE ( do3d(av,ivar)(1:1) /= ' ' ) 392 395 393 396 ! … … 395 398 !-- surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar ). 396 399 !-- Store the array chosen on the temporary array. 397 trimvar = TRIM( do3d(av,i f) )400 trimvar = TRIM( do3d(av,ivar) ) 398 401 IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN 399 402 trimvar = 'usm_output' … … 711 714 !-- Block of urban surface model outputs 712 715 CASE ( 'usm_output' ) 713 CALL usm_data_output_3d( av, do3d(av,i f), found, local_pf, &716 CALL usm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 714 717 nzb_do, nzt_do ) 715 718 … … 719 722 !-- Quantities of other modules 720 723 IF ( .NOT. found .AND. bulk_cloud_model ) THEN 721 CALL bcm_data_output_3d( av, do3d(av,i f), found, local_pf, &724 CALL bcm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 722 725 nzb_do, nzt_do ) 723 726 resorted = .TRUE. … … 725 728 726 729 IF ( .NOT. found .AND. air_chemistry ) THEN 727 CALL chem_data_output_3d( av, do3d(av,i f), found, &730 CALL chem_data_output_3d( av, do3d(av,ivar), found, & 728 731 local_pf, fill_value, nzb_do, nzt_do ) 729 732 resorted = .TRUE. … … 731 734 732 735 IF ( .NOT. found .AND. gust_module_enabled ) THEN 733 CALL gust_data_output_3d( av, do3d(av,i f), found, local_pf, &736 CALL gust_data_output_3d( av, do3d(av,ivar), found, local_pf, & 734 737 nzb_do, nzt_do ) 735 738 resorted = .TRUE. … … 746 749 local_pf = fill_value 747 750 748 CALL lsm_data_output_3d( av, do3d(av,i f), found, local_pf )751 CALL lsm_data_output_3d( av, do3d(av,ivar), found, local_pf ) 749 752 resorted = .TRUE. 750 753 … … 762 765 763 766 IF ( .NOT. found .AND. ocean_mode ) THEN 764 CALL ocean_data_output_3d( av, do3d(av,i f), found, local_pf, &767 CALL ocean_data_output_3d( av, do3d(av,ivar), found, local_pf, & 765 768 nzb_do, nzt_do ) 766 769 resorted = .TRUE. … … 768 771 769 772 IF ( .NOT. found .AND. plant_canopy ) THEN 770 CALL pcm_data_output_3d( av, do3d(av,i f), found, local_pf, &773 CALL pcm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 771 774 fill_value, nzb_do, nzt_do ) 772 775 resorted = .TRUE. … … 774 777 775 778 IF ( .NOT. found .AND. radiation ) THEN 776 CALL radiation_data_output_3d( av, do3d(av,i f), found, &779 CALL radiation_data_output_3d( av, do3d(av,ivar), found, & 777 780 local_pf, nzb_do, nzt_do ) 778 781 resorted = .TRUE. … … 780 783 781 784 IF ( .NOT. found ) THEN 782 CALL tcm_data_output_3d( av, do3d(av,i f), found, local_pf, &785 CALL tcm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 783 786 nzb_do, nzt_do ) 784 787 resorted = .TRUE. … … 788 791 !-- SALSA output 789 792 IF ( .NOT. found .AND. salsa ) THEN 790 CALL salsa_data_output_3d( av, do3d(av,i f), found, local_pf )793 CALL salsa_data_output_3d( av, do3d(av,ivar), found, local_pf ) 791 794 resorted = .TRUE. 792 795 ENDIF 793 796 794 797 IF ( .NOT. found .AND. biometeorology ) THEN 795 CALL bio_data_output_3d( av, do3d(av,i f), found, local_pf, &798 CALL bio_data_output_3d( av, do3d(av,ivar), found, local_pf, & 796 799 nzb_do, nzt_do ) 797 800 ENDIF … … 800 803 !-- User defined quantities 801 804 IF ( .NOT. found ) THEN 802 CALL user_data_output_3d( av, do3d(av,i f), found, local_pf, &805 CALL user_data_output_3d( av, do3d(av,ivar), found, local_pf, & 803 806 nzb_do, nzt_do ) 804 807 resorted = .TRUE. … … 807 810 IF ( .NOT. found ) THEN 808 811 message_string = 'no output available for: ' // & 809 TRIM( do3d(av,i f) )812 TRIM( do3d(av,ivar) ) 810 813 CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 ) 811 814 ENDIF … … 855 858 !-- Parallel output in netCDF4/HDF5 format. 856 859 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 857 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &860 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 858 861 ! local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do), & 859 862 ! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & 860 863 ! count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) ) 861 864 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 862 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &865 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 863 866 ! local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do), & 864 867 ! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & 865 868 ! count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) ) 866 869 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 867 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &870 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 868 871 ! local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do ), & 869 872 ! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & 870 873 ! count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) ) 871 874 ! ELSE 872 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &875 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 873 876 local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do), & 874 877 start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & … … 880 883 #else 881 884 #if defined( __netcdf ) 882 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &885 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 883 886 local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do), & 884 887 start = (/ 1, 1, 1, do3d_time_count(av) /), & … … 888 891 #endif 889 892 890 i f = if+ 1893 ivar = ivar + 1 891 894 892 895 !
Note: See TracChangeset
for help on using the changeset viewer.